mirror of
https://github.com/janet-lang/janet
synced 2025-11-22 02:04:49 +00:00
Compare commits
161 Commits
pointer
...
configchec
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3c304ddc35 | ||
|
|
ce9cd4fcef | ||
|
|
698e89aba4 | ||
|
|
4c8dd4b96c | ||
|
|
11998b3913 | ||
|
|
840610facf | ||
|
|
0280deccae | ||
|
|
4d5a95784a | ||
|
|
b43d93cf55 | ||
|
|
3f137ed0b1 | ||
|
|
5deb13d73e | ||
|
|
82a1c8635e | ||
|
|
010e2e4652 | ||
|
|
ddedae6831 | ||
|
|
6c63c4f129 | ||
|
|
802686e3df | ||
|
|
3be79e8735 | ||
|
|
a303704a7d | ||
|
|
b5e6c0b8fc | ||
|
|
98c46fcfb1 | ||
|
|
409da697dd | ||
|
|
91c3685705 | ||
|
|
411fc77ecf | ||
|
|
0378ba78cc | ||
|
|
55d8e8b56b | ||
|
|
97ad4c4f89 | ||
|
|
8de999c8f7 | ||
|
|
f444bd25ef | ||
|
|
43c0db4b0e | ||
|
|
8f168c600d | ||
|
|
ec43afb426 | ||
|
|
880049c0ee | ||
|
|
2b7ac16784 | ||
|
|
56d903d75b | ||
|
|
7054e878fb | ||
|
|
dde5351d11 | ||
|
|
7d49e3e6f1 | ||
|
|
30cb01e2f0 | ||
|
|
018e836ef5 | ||
|
|
7b25125431 | ||
|
|
0aa2f68793 | ||
|
|
516e031f67 | ||
|
|
3331f2fa02 | ||
|
|
dd1a199ebd | ||
|
|
f35b5765d6 | ||
|
|
8359044408 | ||
|
|
9f3dde3cc7 | ||
|
|
ad0f7d9b0d | ||
|
|
f647ac5631 | ||
|
|
e4c5eb4c76 | ||
|
|
dc9fc9c3f5 | ||
|
|
3b6a51df24 | ||
|
|
f2313b9959 | ||
|
|
805b3bbb88 | ||
|
|
232ea22dc5 | ||
|
|
3388acd2db | ||
|
|
52ab9fb475 | ||
|
|
c7dc3611bc | ||
|
|
7a313f6038 | ||
|
|
bbcfaf1289 | ||
|
|
bfb0cb331e | ||
|
|
1759252071 | ||
|
|
fff60b053b | ||
|
|
65ac17986a | ||
|
|
ff720f1320 | ||
|
|
5a28d8d1fa | ||
|
|
ea25766374 | ||
|
|
88b8418253 | ||
|
|
4fa1b28cad | ||
|
|
c70d59edee | ||
|
|
5694998382 | ||
|
|
1cfc7b3b0d | ||
|
|
03e3ecb0a1 | ||
|
|
f8935b0692 | ||
|
|
702b50b7a1 | ||
|
|
e7baa2ae3d | ||
|
|
bfb354b469 | ||
|
|
3c0f12ea4d | ||
|
|
25a93ac4a6 | ||
|
|
0bad523913 | ||
|
|
5b36199aea | ||
|
|
a474a640be | ||
|
|
f10028d41a | ||
|
|
eb4684a64d | ||
|
|
73b81e0253 | ||
|
|
027f106a56 | ||
|
|
20e94adb61 | ||
|
|
9100794cea | ||
|
|
4ddf90e301 | ||
|
|
d1eca1cf52 | ||
|
|
7918add47d | ||
|
|
513d551df6 | ||
|
|
ddaa5e34e6 | ||
|
|
208eb7520a | ||
|
|
2d7df6b78e | ||
|
|
7527142549 | ||
|
|
4e6193b67e | ||
|
|
4ded5e10a2 | ||
|
|
1596511175 | ||
|
|
d514eab627 | ||
|
|
5287007cd6 | ||
|
|
e5a56174e2 | ||
|
|
6c68c7a35f | ||
|
|
675c1030fd | ||
|
|
ed65d04b81 | ||
|
|
fa1c5c85b5 | ||
|
|
59c69e6896 | ||
|
|
ee35786c8f | ||
|
|
ec6e2cfd62 | ||
|
|
7d48e7fd1f | ||
|
|
0063e3a69d | ||
|
|
cd6c009c03 | ||
|
|
b15cf193a0 | ||
|
|
429dc70374 | ||
|
|
e50e77e5f9 | ||
|
|
2fdd6aa0f7 | ||
|
|
cc55364b21 | ||
|
|
71526d1d9b | ||
|
|
e239980da7 | ||
|
|
1709bce77e | ||
|
|
d6ba2de888 | ||
|
|
61c0a4bc87 | ||
|
|
8af28d3fa5 | ||
|
|
970923d0e5 | ||
|
|
5d7dc0a57c | ||
|
|
c5090606a4 | ||
|
|
bf2d9ae634 | ||
|
|
871a58e1db | ||
|
|
53c7f2eedd | ||
|
|
bfd3845218 | ||
|
|
22d75d017f | ||
|
|
37e6ea0a23 | ||
|
|
10769f6f2e | ||
|
|
082639319e | ||
|
|
f20ad34c76 | ||
|
|
c045eadefa | ||
|
|
e2337b2ec4 | ||
|
|
90c5d12613 | ||
|
|
6016662807 | ||
|
|
2c9195b507 | ||
|
|
b47c48b59a | ||
|
|
98758b68ab | ||
|
|
7f1b5d4d70 | ||
|
|
25aa7a26c5 | ||
|
|
cb2caecbb3 | ||
|
|
1e299632e4 | ||
|
|
94a2084723 | ||
|
|
22e24fb47b | ||
|
|
93f0d5f626 | ||
|
|
bad040665f | ||
|
|
a07d76b264 | ||
|
|
1db6d0e0bc | ||
|
|
34849ea7b3 | ||
|
|
5a9f7c3a85 | ||
|
|
15c6300608 | ||
|
|
c6a4485623 | ||
|
|
090c6ac975 | ||
|
|
319575c864 | ||
|
|
42a0af3b1b | ||
|
|
9bc899ccf2 | ||
|
|
d29e3a1199 |
@@ -2,8 +2,6 @@ image: freebsd/latest
|
||||
packages:
|
||||
- gmake
|
||||
- gcc
|
||||
sources:
|
||||
- https://github.com/janet-lang/janet.git
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
@@ -11,3 +9,4 @@ tasks:
|
||||
gmake test CC=gcc
|
||||
sudo gmake install CC=gcc
|
||||
gmake test-install CC=gcc
|
||||
gmake test-amalg CC=gcc
|
||||
|
||||
11
.builds/.openbsd.yaml
Normal file
11
.builds/.openbsd.yaml
Normal file
@@ -0,0 +1,11 @@
|
||||
image: openbsd/6.5
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
8
.gitignore
vendored
8
.gitignore
vendored
@@ -4,6 +4,7 @@ dst
|
||||
janet
|
||||
!*/**/janet
|
||||
/build
|
||||
/builddir
|
||||
/Build
|
||||
/Release
|
||||
/Debug
|
||||
@@ -12,6 +13,13 @@ janet
|
||||
janet-*.tar.gz
|
||||
dist
|
||||
|
||||
# VSCode
|
||||
.vscode
|
||||
|
||||
# Eclipse
|
||||
.project
|
||||
.cproject
|
||||
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
|
||||
@@ -4,6 +4,7 @@ script:
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- make test-amalg
|
||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
|
||||
47
CHANGELOG.md
47
CHANGELOG.md
@@ -1,8 +1,53 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 0.4.1 latest - ??
|
||||
## 1.0.0 - ??
|
||||
|
||||
- Add optional filters to `module/paths` to further refine import methods.
|
||||
- Add keyword arguments via `&keys` in parameter list.
|
||||
- Add `-k` flag for flychecking source.
|
||||
- Change signature to `compile` function.
|
||||
- Add `module/loaders` for custom loading functions.
|
||||
- Add external unification to `match` macro.
|
||||
- Add static library to main build.
|
||||
- Add `janet/*headerpath*` and change location of installed headers.
|
||||
- Let `partition` take strings.
|
||||
- Haiku OS support
|
||||
- Add `string/trim`, `string/trimr`, and `string/triml`.
|
||||
- Add `dofile` function.
|
||||
- Numbers require at least 1 significant digit.
|
||||
- `file/read` will return nil on end of file.
|
||||
- Fix various bugs.
|
||||
|
||||
## 0.5.0 - 2019-05-09
|
||||
- Fix some bugs with buffers.
|
||||
- Add `trace` and `untrace` to the core library.
|
||||
- Add `string/has-prefix?` and `string/has-suffix?` to string module.
|
||||
- Add simple debugger to repl that activates on errors or debug signal
|
||||
- Remove `*env*` and `*doc-width*`.
|
||||
- Add `fiber/getenv`, `fiber/setenv`, and `dyn`, and `setdyn`.
|
||||
- Add support for dynamic bindings (via the `dyn` and `setdyn` functions).
|
||||
- Change signatures of some functions like `eval` which no longer takes
|
||||
an optional environment.
|
||||
- Add printf function
|
||||
- Make `pp` configurable with dynamic binding `:pretty-format`.
|
||||
- Remove the `meta` function.
|
||||
- Add `with-dyns` for blocks with dynamic bindings assigned.
|
||||
- Allow leading and trailing newlines in backtick-delimited string (long strings).
|
||||
These newlines will not be included in the actual string value.
|
||||
|
||||
## 0.4.1 - 2019-04-14
|
||||
- Squash some bugs
|
||||
- Peg patterns can now make captures in any position in a grammar.
|
||||
- Add color to repl output
|
||||
- Add array/remove function
|
||||
- Add meson build support
|
||||
- Add int module for int types
|
||||
- Add meson build option
|
||||
- Add (break) special form and improve loop macro
|
||||
- Allow abstract types to specify custom tostring method
|
||||
- Extend C API for marshalling abstract types and other values
|
||||
- Add functions to `os` module.
|
||||
|
||||
## 0.4.0 - 2019-03-08
|
||||
- Fix a number of smaller bugs
|
||||
|
||||
170
Makefile
170
Makefile
@@ -26,12 +26,15 @@ PREFIX?=/usr/local
|
||||
|
||||
INCLUDEDIR=$(PREFIX)/include
|
||||
BINDIR=$(PREFIX)/bin
|
||||
LIBDIR=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||
CLIBS=-lm
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(PREFIX)/lib/janet
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
||||
@@ -46,30 +49,85 @@ else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME),Haiku)
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
||||
|
||||
# Source headers
|
||||
JANET_HEADERS=$(sort $(wildcard src/include/*.h))
|
||||
JANET_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
|
||||
######################
|
||||
##### Name Files #####
|
||||
######################
|
||||
|
||||
# Source files
|
||||
JANET_CORE_SOURCES=$(sort $(wildcard src/core/*.c))
|
||||
JANET_MAINCLIENT_SOURCES=$(sort $(wildcard src/mainclient/*.c))
|
||||
JANET_WEBCLIENT_SOURCES=$(sort $(wildcard src/webclient/*.c))
|
||||
JANET_HEADERS=src/include/janet.h src/include/janetconf.h
|
||||
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
||||
JANET_LOCAL_HEADERS=src/core/util.h \
|
||||
src/core/state.h \
|
||||
src/core/gc.h \
|
||||
src/core/vector.h \
|
||||
src/core/fiber.h \
|
||||
src/core/regalloc.h \
|
||||
src/core/compile.h \
|
||||
src/core/emit.h \
|
||||
src/core/symcache.h
|
||||
|
||||
JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/array.c \
|
||||
src/core/asm.c \
|
||||
src/core/buffer.c \
|
||||
src/core/bytecode.c \
|
||||
src/core/capi.c \
|
||||
src/core/cfuns.c \
|
||||
src/core/compile.c \
|
||||
src/core/corelib.c \
|
||||
src/core/debug.c \
|
||||
src/core/emit.c \
|
||||
src/core/fiber.c \
|
||||
src/core/gc.c \
|
||||
src/core/inttypes.c \
|
||||
src/core/io.c \
|
||||
src/core/marsh.c \
|
||||
src/core/math.c \
|
||||
src/core/os.c \
|
||||
src/core/parse.c \
|
||||
src/core/peg.c \
|
||||
src/core/pp.c \
|
||||
src/core/regalloc.c \
|
||||
src/core/run.c \
|
||||
src/core/specials.c \
|
||||
src/core/string.c \
|
||||
src/core/strtod.c \
|
||||
src/core/struct.c \
|
||||
src/core/symcache.c \
|
||||
src/core/table.c \
|
||||
src/core/tuple.c \
|
||||
src/core/typedarray.c \
|
||||
src/core/util.c \
|
||||
src/core/value.c \
|
||||
src/core/vector.c \
|
||||
src/core/vm.c \
|
||||
src/core/wrap.c
|
||||
|
||||
JANET_BOOT_SOURCES=src/boot/array_test.c \
|
||||
src/boot/boot.c \
|
||||
src/boot/buffer_test.c \
|
||||
src/boot/number_test.c \
|
||||
src/boot/system_test.c \
|
||||
src/boot/table_test.c
|
||||
|
||||
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
|
||||
|
||||
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
|
||||
|
||||
##################################################################
|
||||
##### The bootstrap interpreter that compiles the core image #####
|
||||
##################################################################
|
||||
|
||||
JANET_BOOT_SOURCES=$(sort $(wildcard src/boot/*.c))
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||
build/core.gen.o \
|
||||
build/boot.gen.o
|
||||
|
||||
build/%.boot.o: src/%.c
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
@@ -77,7 +135,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/core_image.c: build/janet_boot
|
||||
JANET_PATH=$(JANET_PATH) build/janet_boot
|
||||
build/janet_boot $@ JANET_PATH $(JANET_PATH) JANET_HEADERPATH $(INCLUDEDIR)/janet
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
@@ -99,6 +157,9 @@ $(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
######################
|
||||
##### Emscripten #####
|
||||
######################
|
||||
@@ -138,8 +199,6 @@ emscripten: $(JANET_EMTARGET)
|
||||
build/xxd: tools/xxd.c
|
||||
$(CC) $< -o $@
|
||||
|
||||
build/core.gen.c: src/core/core.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_core
|
||||
build/init.gen.c: src/mainclient/init.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_init
|
||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||
@@ -153,8 +212,9 @@ build/boot.gen.c: src/boot/boot.janet build/xxd
|
||||
|
||||
amalg: build/janet.c build/janet.h build/core_image.c
|
||||
|
||||
build/janet.c: $(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) tools/amalg.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/amalg.janet > $@
|
||||
AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
|
||||
build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
|
||||
|
||||
build/janet.h: src/include/janet.h
|
||||
cp $< $@
|
||||
@@ -191,8 +251,9 @@ callgrind: $(JANET_TARGET)
|
||||
|
||||
dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) src/include/janet.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) \
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
src/include/janet.h src/include/janetconf.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c
|
||||
tar -czvf $@ $^
|
||||
|
||||
@@ -205,16 +266,52 @@ docs: build/doc.html
|
||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
|
||||
########################
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.PHONY: $(PKG_CONFIG_PATH)/janet.pc
|
||||
$(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||
mkdir -p $(PKG_CONFIG_PATH)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
echo 'exec_prefix=$${prefix}' >> $@
|
||||
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
||||
echo 'libdir=$(LIBDIR)' >> $@
|
||||
echo "" >> $@
|
||||
echo "Name: janet" >> $@
|
||||
echo "Url: https://janet-lang.org" >> $@
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
|
||||
mkdir -p $(BINDIR)
|
||||
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||
mkdir -p $(INCLUDEDIR)/janet
|
||||
cp -rf $(JANET_HEADERS) $(INCLUDEDIR)/janet
|
||||
mkdir -p $(JANET_PATH)
|
||||
mkdir -p $(LIBDIR)
|
||||
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')
|
||||
cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a
|
||||
ln -sf $(SONAME) $(LIBDIR)/libjanet.so
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||
cp tools/cook.janet $(JANET_PATH)
|
||||
cp tools/highlight.janet $(JANET_PATH)
|
||||
cp tools/bars.janet $(JANET_PATH)
|
||||
mkdir -p $(MANPATH)
|
||||
cp janet.1 $(MANPATH)
|
||||
-ldconfig $(LIBDIR)
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
#################
|
||||
|
||||
STYLEOPTS=--style=attach --indent-switches --convert-tabs \
|
||||
--align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels
|
||||
format:
|
||||
astyle $(STYLEOPTS) */*.c
|
||||
astyle $(STYLEOPTS) */*/*.c
|
||||
astyle $(STYLEOPTS) */*/*.h
|
||||
tools/format.sh
|
||||
|
||||
grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
@@ -223,23 +320,18 @@ build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
|
||||
install: $(JANET_TARGET)
|
||||
mkdir -p $(BINDIR)
|
||||
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||
mkdir -p $(INCLUDEDIR)
|
||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
||||
mkdir -p $(INCLUDEDIR)/janet
|
||||
mkdir -p $(JANET_PATH)
|
||||
ln -sf $(INCLUDEDIR)/janet.h $(INCLUDEDIR)/janet/janet.h
|
||||
ln -sf $(INCLUDEDIR)/janet.h $(JANET_PATH)/janet.h
|
||||
cp tools/cook.janet $(JANET_PATH)
|
||||
cp tools/highlight.janet $(JANET_PATH)
|
||||
cp tools/bars.janet $(JANET_PATH)
|
||||
mkdir -p $(MANPATH)
|
||||
cp janet.1 $(MANPATH)
|
||||
|
||||
test-install:
|
||||
cd test/install && rm -rf build && janet test
|
||||
cd test/install && rm -rf build && janet build && janet build
|
||||
|
||||
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_test: build/embed_janet.o build/embed_main.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
test-amalg: build/embed_test
|
||||
./build/embed_test
|
||||
|
||||
uninstall:
|
||||
-rm $(BINDIR)/../$(JANET_TARGET)
|
||||
|
||||
171
README.md
171
README.md
@@ -3,6 +3,7 @@
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
@@ -16,15 +17,7 @@ to run script files. This client program is separate from the core runtime, so
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
#
|
||||
|
||||
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
||||
The few features that are not standard C (dynamic library loading, compiler specific optimizations),
|
||||
are fairly straight forward. Janet can be easily ported to new platforms.
|
||||
|
||||
For syntax highlighting, there is some preliminary vim syntax highlighting in [janet.vim](https://github.com/janet-lang/janet.vim).
|
||||
Generic lisp syntax highlighting should, however, provide good results. One can also generate a janet.tmLanguage
|
||||
file for other programs with `make grammar`.
|
||||
<br>
|
||||
|
||||
## Use Cases
|
||||
|
||||
@@ -56,17 +49,12 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
|
||||
## Documentation
|
||||
|
||||
Documentation can be found in the doc directory of
|
||||
the repository. There is an introduction
|
||||
section contains a good overview of the language.
|
||||
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||
|
||||
API documentation for all bindings can also be generated
|
||||
with `make docs`, which will create `build/doc.html`, which
|
||||
can be viewed with any web browser. This
|
||||
includes all forms in the core library except special forms.
|
||||
|
||||
For individual bindings from within the REPL, use the `(doc symbol-name)` macro to get API
|
||||
documentation for the core library. For example,
|
||||
Documentation is also available locally in the repl.
|
||||
Use the `(doc symbol-name)` macro to get API
|
||||
documentation for symbols in the core library. For example,
|
||||
```
|
||||
(doc doc)
|
||||
```
|
||||
@@ -75,12 +63,73 @@ Shows documentation for the doc macro.
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-symbols)` function.
|
||||
|
||||
## Source
|
||||
|
||||
You can get the source on [GitHub](https://github.com/janet-lang/janet) or
|
||||
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
||||
the SourceHut mirror is actively maintained.
|
||||
|
||||
## Building
|
||||
|
||||
### macos and Unix-like
|
||||
|
||||
```
|
||||
cd somewhere/my/projects/janet
|
||||
make
|
||||
make test
|
||||
make repl
|
||||
```
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||
|
||||
```
|
||||
cd somewhere/my/projects/janet
|
||||
make CC=gcc-x86
|
||||
make test
|
||||
make repl
|
||||
```
|
||||
|
||||
### FreeBSD
|
||||
|
||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||
but you need `gmake` to compile. Alternatively, install directly from
|
||||
packages, using `pkg install lang/janet`.
|
||||
|
||||
```
|
||||
cd somewhere/my/projects/janet
|
||||
gmake
|
||||
gmake test
|
||||
gmake repl
|
||||
```
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
||||
3. Run `build_win` to compile janet.
|
||||
4. Run `build_win test` to make sure everything is working.
|
||||
|
||||
### Emscripten
|
||||
|
||||
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
||||
have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
|
||||
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
||||
The JavaScript build is what runs the repl on the main website,
|
||||
but really serves mainly as a proof of concept. Janet will run slower in a browser.
|
||||
Building with emscripten on windows is currently unsupported.
|
||||
|
||||
### Meson
|
||||
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||
system. This is not currently the main supported build system, but should work on any
|
||||
system that supports meson. Meson also provides much better IDE integration than Make or batch files.
|
||||
|
||||
## Installation
|
||||
|
||||
Install a stable version of janet from the [releases page](https://github.com/janet-lang/janet/releases).
|
||||
Janet is prebuilt for a few systems, but if you want to develop janet, run janet on a non-x86 system, or
|
||||
get the latest, you must build janet from source. Janet is in alpha and may change
|
||||
in backwards incompatible ways.
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details.
|
||||
|
||||
## Usage
|
||||
|
||||
@@ -112,68 +161,22 @@ Options are:
|
||||
$
|
||||
```
|
||||
|
||||
If installed, you can also run `man janet` to get usage information.
|
||||
|
||||
## Embedding
|
||||
|
||||
The C API for Janet is not yet documented but coming soon.
|
||||
|
||||
Janet can be embedded in a host program very easily. There is a make target `make amalg`
|
||||
which creates the file `build/janet.c`, which is a single C file that contains all the source
|
||||
to Janet. This file, along with `src/include/janet/janet.h` can dragged into any C project
|
||||
and compiled into the project. Janet should be compiled with `-std=c99` on most compilers, and
|
||||
will need to be linked to the math library, `-lm`, and the dynamic linker, `-ldl`, if one wants
|
||||
to be able to load dynamic modules. If there is no need for dynamic modules, add the define
|
||||
Janet can be embedded in a host program very easily. There is a make target
|
||||
`make amalg` which creates the file `build/janet.c`, which is a single C file
|
||||
that contains all the source to Janet. This file, along with
|
||||
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
|
||||
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||
there is no need for dynamic modules, add the define
|
||||
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
|
||||
|
||||
## Compiling and Running
|
||||
|
||||
Janet only uses Make and batch files to compile on Posix and windows
|
||||
respectively. To configure janet, edit the header file src/include/janet/janet.h
|
||||
before compilation.
|
||||
|
||||
### macos and Unix-like
|
||||
|
||||
On most platforms, use Make to build janet. The resulting binary will be in `build/janet`.
|
||||
|
||||
```sh
|
||||
cd somewhere/my/projects/janet
|
||||
make
|
||||
make test
|
||||
```
|
||||
|
||||
After building, run `make install` to install the janet binary and libs.
|
||||
Will install in `/usr/local` by default, see the Makefile to customize.
|
||||
|
||||
It's also recommended to set the `JANET_PATH` variable in your profile.
|
||||
This is where janet will look for imported libraries after the current directory.
|
||||
|
||||
### FreeBSD
|
||||
|
||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||
but you need `gmake` and `gcc` to compile.
|
||||
|
||||
```
|
||||
cd somewhere/my/projects/janet
|
||||
gmake CC=gcc
|
||||
gmake test CC=gcc
|
||||
```
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#)
|
||||
or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
||||
3. Run `build_win` to compile janet.
|
||||
4. Run `build_win test` to make sure everything is working.
|
||||
|
||||
### Emscripten
|
||||
|
||||
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
||||
have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
|
||||
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
||||
The JavaScript build is what runs the repl on the main website,
|
||||
but really serves mainly as a proof of concept. Janet will run slower in a browser.
|
||||
Building with emscripten on windows is currently unsupported.
|
||||
|
||||
## Examples
|
||||
|
||||
See the examples directory for some example janet code.
|
||||
@@ -183,6 +186,16 @@ See the examples directory for some example janet code.
|
||||
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||
|
||||
## FAQ
|
||||
|
||||
### Why is my terminal is spitting out junk when I run the repl?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
support these, but some older terminals, windows consoles, or embedded terminals
|
||||
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
## Why Janet
|
||||
|
||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||
|
||||
@@ -31,16 +31,12 @@ mkdir build\boot
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Generate the embedded sources
|
||||
@build\xxd.exe src\core\core.janet build\core.gen.c janet_gen_core
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the generated sources
|
||||
@%JANET_COMPILE% /Fobuild\boot\core.gen.obj build\core.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||
@@ -57,9 +53,7 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
set JANET_PATH="C:/Janet/Library"
|
||||
set JANET_INCLUDEDIR="C:/Janet/Include"
|
||||
build\janet_boot
|
||||
build\janet_boot build\core_image.c JANET_PATH "C:/Janet/Library"
|
||||
|
||||
@rem Build the core image
|
||||
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@@ -81,6 +75,14 @@ for %%f in (src\mainclient\*.c) do (
|
||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
for %%f in (src\core\*.c) do (
|
||||
set "amalg_files=!amalg_files! %%f"
|
||||
)
|
||||
janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||
@@ -118,13 +120,15 @@ exit /b 0
|
||||
:DIST
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\amalg.janet > dist\janet.c
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
copy janet.lib dist\janet.lib
|
||||
copy janet.exp dist\janet.exp
|
||||
copy src\include\janet.h dist\janet.h
|
||||
copy src\include\janetconf.h dist\janetconf.h
|
||||
copy tools\cook.janet dist\cook.janet
|
||||
copy tools\highlight.janet dist\highlight.janet
|
||||
exit /b 0
|
||||
|
||||
@@ -14,5 +14,5 @@
|
||||
(map keys (keys solutions)))
|
||||
|
||||
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
||||
(print "3sum of " (string/pretty arr) ":")
|
||||
(print (string/pretty (sum3 arr)))
|
||||
(printf "3sum of %P: " arr)
|
||||
(printf "%P\n" (sum3 arr))
|
||||
|
||||
@@ -2,10 +2,8 @@
|
||||
# of the triangle to the leaves of the triangle.
|
||||
|
||||
(defn myfold [xs ys]
|
||||
(let [xs1 (tuple/prepend xs 0)
|
||||
xs2 (tuple/append xs 0)
|
||||
m1 (map + xs1 ys)
|
||||
m2 (map + xs2 ys)]
|
||||
(let [m1 (map + [;xs 0] ys)
|
||||
m2 (map + [0 ;xs] ys)]
|
||||
(map max m1 m2)))
|
||||
|
||||
(defn maxpath [t]
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
|
||||
(import build/numarray :prefix "")
|
||||
(import build/numarray :as numarray)
|
||||
|
||||
(def a (numarray/new 30))
|
||||
(print (get a 20))
|
||||
|
||||
@@ -100,12 +100,12 @@ Janet num_array_get(void *p, Janet key) {
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{
|
||||
"numarray/new", num_array_new,
|
||||
"new", num_array_new,
|
||||
"(numarray/new size)\n\n"
|
||||
"Create new numarray"
|
||||
},
|
||||
{
|
||||
"numarray/scale", num_array_scale,
|
||||
"scale", num_array_scale,
|
||||
"(numarray/scale numarray factor)\n\n"
|
||||
"scale numarray by factor"
|
||||
},
|
||||
|
||||
@@ -13,4 +13,4 @@
|
||||
(if isprime? (array/push list i)))
|
||||
list)
|
||||
|
||||
(print (string/pretty (primes 100)))
|
||||
(pp (primes 100))
|
||||
|
||||
29
examples/urlloader.janet
Normal file
29
examples/urlloader.janet
Normal file
@@ -0,0 +1,29 @@
|
||||
# An example of using Janet's extensible module system
|
||||
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
|
||||
# from the repl, and then:
|
||||
#
|
||||
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
|
||||
#
|
||||
# This will import a file using curl. You can then try
|
||||
#
|
||||
# (print (c/color :green "Hello!"))
|
||||
#
|
||||
# This is a bit of a toy example (it just shells out to curl), but it is very
|
||||
# powerful and will work well in many cases.
|
||||
|
||||
(defn- load-url
|
||||
[url args]
|
||||
(def f (file/popen (string "curl " url)))
|
||||
(def res (dofile f :source url ;args))
|
||||
(try (file/close f) ([err] nil))
|
||||
res)
|
||||
|
||||
(defn- check-http-url
|
||||
[path]
|
||||
(if (or (string/has-prefix? "http://" path)
|
||||
(string/has-prefix? "https://" path))
|
||||
path))
|
||||
|
||||
# Add the module loader and path tuple to right places
|
||||
(array/push module/paths [check-http-url :janet-http])
|
||||
(put module/loaders :janet-http load-url)
|
||||
10
janet.1
10
janet.1
@@ -3,7 +3,7 @@
|
||||
janet \- run the Janet language abstract machine
|
||||
.SH SYNOPSIS
|
||||
.B janet
|
||||
[\fB\-hvsrpq\fR]
|
||||
[\fB\-hvsrpnqk\fR]
|
||||
[\fB\-e\fR \fISOURCE\fR]
|
||||
[\fB\-l\fR \fIMODULE\fR]
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
@@ -48,6 +48,10 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
|
||||
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
||||
arguments are executed before later ones.
|
||||
|
||||
.TP
|
||||
.BR \-n
|
||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
|
||||
.TP
|
||||
.BR \-r
|
||||
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
||||
@@ -63,6 +67,10 @@ after an error. Persistent mode can be good for debugging and testing.
|
||||
.BR \-q
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
|
||||
.TP
|
||||
.BR \-k
|
||||
Don't execute a script, only compile it to check for errors. Useful for linting scripts.
|
||||
|
||||
.TP
|
||||
.BR \-m\ syspath
|
||||
Set the variable module/*syspath* to the string syspath so that Janet will load system modules
|
||||
|
||||
179
meson.build
Normal file
179
meson.build
Normal file
@@ -0,0 +1,179 @@
|
||||
# Copyright (c) 2019 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
project('janet', 'c', default_options : ['c_std=c99'])
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
|
||||
|
||||
# Link math library on all systems
|
||||
cc = meson.get_compiler('c')
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
|
||||
# Some options
|
||||
add_project_link_arguments('-rdynamic', language : 'c')
|
||||
|
||||
# Include directories
|
||||
incdir = include_directories('src/include')
|
||||
|
||||
# Building generated sources
|
||||
xxd = executable('xxd', 'tools/xxd.c')
|
||||
gen = generator(xxd,
|
||||
output : '@BASENAME@.gen.c',
|
||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||
boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot')
|
||||
init_gen = gen.process('src/mainclient/init.janet', extra_args: 'janet_gen_init')
|
||||
|
||||
# Order is important here, as some headers
|
||||
# depend on other headers for the amalg target
|
||||
core_headers = [
|
||||
'src/core/util.h',
|
||||
'src/core/state.h',
|
||||
'src/core/gc.h',
|
||||
'src/core/vector.h',
|
||||
'src/core/fiber.h',
|
||||
'src/core/regalloc.h',
|
||||
'src/core/compile.h',
|
||||
'src/core/emit.h',
|
||||
'src/core/symcache.h'
|
||||
]
|
||||
|
||||
core_src = [
|
||||
'src/core/abstract.c',
|
||||
'src/core/array.c',
|
||||
'src/core/asm.c',
|
||||
'src/core/buffer.c',
|
||||
'src/core/bytecode.c',
|
||||
'src/core/capi.c',
|
||||
'src/core/cfuns.c',
|
||||
'src/core/compile.c',
|
||||
'src/core/corelib.c',
|
||||
'src/core/debug.c',
|
||||
'src/core/emit.c',
|
||||
'src/core/fiber.c',
|
||||
'src/core/gc.c',
|
||||
'src/core/inttypes.c',
|
||||
'src/core/io.c',
|
||||
'src/core/marsh.c',
|
||||
'src/core/math.c',
|
||||
'src/core/os.c',
|
||||
'src/core/parse.c',
|
||||
'src/core/peg.c',
|
||||
'src/core/pp.c',
|
||||
'src/core/regalloc.c',
|
||||
'src/core/run.c',
|
||||
'src/core/specials.c',
|
||||
'src/core/string.c',
|
||||
'src/core/strtod.c',
|
||||
'src/core/struct.c',
|
||||
'src/core/symcache.c',
|
||||
'src/core/table.c',
|
||||
'src/core/tuple.c',
|
||||
'src/core/typedarray.c',
|
||||
'src/core/util.c',
|
||||
'src/core/value.c',
|
||||
'src/core/vector.c',
|
||||
'src/core/vm.c',
|
||||
'src/core/wrap.c'
|
||||
]
|
||||
|
||||
boot_src = [
|
||||
'src/boot/array_test.c',
|
||||
'src/boot/boot.c',
|
||||
'src/boot/buffer_test.c',
|
||||
'src/boot/number_test.c',
|
||||
'src/boot/system_test.c',
|
||||
'src/boot/table_test.c',
|
||||
]
|
||||
|
||||
mainclient_src = [
|
||||
'src/mainclient/line.c',
|
||||
'src/mainclient/main.c'
|
||||
]
|
||||
|
||||
# Build boot binary
|
||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep])
|
||||
|
||||
# Build core image
|
||||
core_image = custom_target('core_image',
|
||||
input : [janet_boot],
|
||||
output : 'core_image.gen.c',
|
||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||
|
||||
libjanet = shared_library('janet', core_src, core_image,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
install : true)
|
||||
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
install : true)
|
||||
|
||||
# Documentation
|
||||
docs = custom_target('docs',
|
||||
input : ['tools/gendoc.janet'],
|
||||
output : ['doc.html'],
|
||||
capture : true,
|
||||
command : [janet_mainclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated source
|
||||
amalg = custom_target('amalg',
|
||||
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||
output : ['janet.c'],
|
||||
capture : true,
|
||||
command : [janet_mainclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
build_by_default : false)
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0.janet',
|
||||
'test/suite1.janet',
|
||||
'test/suite2.janet',
|
||||
'test/suite3.janet',
|
||||
'test/suite4.janet',
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_mainclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
endforeach
|
||||
|
||||
# Repl
|
||||
run_target('repl', command : [janet_mainclient])
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet')
|
||||
janet_libs = [
|
||||
'tools/bars.janet',
|
||||
'tools/cook.janet',
|
||||
'tools/highlight.janet'
|
||||
]
|
||||
install_data(sources : janet_libs, install_dir : janet_path)
|
||||
@@ -26,7 +26,7 @@
|
||||
extern const unsigned char *janet_gen_boot;
|
||||
extern int32_t janet_gen_boot_size;
|
||||
|
||||
int main() {
|
||||
int main(int argc, const char **argv) {
|
||||
|
||||
/* Init janet */
|
||||
janet_init();
|
||||
@@ -46,6 +46,12 @@ int main() {
|
||||
|
||||
env = janet_core_env(NULL);
|
||||
|
||||
/* Create args tuple */
|
||||
JanetArray *args = janet_array(argc);
|
||||
for (int i = 0; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
||||
|
||||
|
||||
1869
src/boot/boot.janet
1869
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -45,6 +45,8 @@ int system_test() {
|
||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||
|
||||
assert(NULL != &janet_wrap_nil);
|
||||
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
|
||||
@@ -182,8 +182,8 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t j, len;
|
||||
const Janet *vals;
|
||||
int32_t j, len = 0;
|
||||
const Janet *vals = NULL;
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
for (j = 0; j < len; j++)
|
||||
janet_array_push(array, vals[j]);
|
||||
@@ -266,7 +266,7 @@ static const JanetReg array_cfuns[] = {
|
||||
{
|
||||
"array/ensure", cfun_array_ensure,
|
||||
JDOC("(array/ensure arr capacity)\n\n"
|
||||
"Ensures that the memory backing the array has enough memory for capacity "
|
||||
"Ensures that the memory backing the array is large enough for capacity "
|
||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space.")
|
||||
|
||||
@@ -101,6 +101,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
||||
{"ltn", JOP_NUMERIC_LESS_THAN},
|
||||
{"mkarr", JOP_MAKE_ARRAY},
|
||||
{"mkbtp", JOP_MAKE_BRACKET_TUPLE},
|
||||
{"mkbuf", JOP_MAKE_BUFFER},
|
||||
{"mkstr", JOP_MAKE_STRING},
|
||||
{"mkstu", JOP_MAKE_STRUCT},
|
||||
|
||||
@@ -208,6 +208,10 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.bytes == buffer->data) {
|
||||
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||
view.bytes = buffer->data;
|
||||
}
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
return argv[0];
|
||||
@@ -296,6 +300,7 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||
JanetByteView src = janet_getbytes(argv, 1);
|
||||
int same_buf = src.bytes == dest->data;
|
||||
int32_t offset_dest = 0;
|
||||
int32_t offset_src = 0;
|
||||
if (argc > 2)
|
||||
@@ -315,7 +320,12 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
janet_panic("buffer blit out of range");
|
||||
janet_buffer_ensure(dest, (int32_t) last, 2);
|
||||
if (last > dest->count) dest->count = (int32_t) last;
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
if (same_buf) {
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Look up table for instructions */
|
||||
@@ -85,10 +86,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SS, /* JOP_LENGTH */
|
||||
JINT_S, /* JOP_MAKE_ARRAY */
|
||||
JINT_S, /* JOP_MAKE_BUFFER */
|
||||
JINT_S, /* JOP_MAKE_TUPLE */
|
||||
JINT_S, /* JOP_MAKE_STRING */
|
||||
JINT_S, /* JOP_MAKE_STRUCT */
|
||||
JINT_S, /* JOP_MAKE_TABLE */
|
||||
JINT_S, /* JOP_MAKE_STRING */
|
||||
JINT_S, /* JOP_MAKE_TUPLE */
|
||||
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
|
||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
|
||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
|
||||
|
||||
@@ -26,6 +26,16 @@
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
static JanetBuildConfig *api_build_config = &(JanetBuildConfig){
|
||||
.api_version = JANET_API_VERSION,
|
||||
.single_threaded = JANET_SINGLE_THREADED_BIT,
|
||||
.nanbox = JANET_NANBOX_BIT
|
||||
};
|
||||
|
||||
const JanetBuildConfig *janet_build_config() {
|
||||
return api_build_config;
|
||||
}
|
||||
|
||||
void janet_panicv(Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
@@ -36,6 +46,34 @@ void janet_panicv(Janet message) {
|
||||
}
|
||||
}
|
||||
|
||||
void janet_panicf(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatb(&buffer, format, args);
|
||||
va_end(args);
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
janet_panics(ret);
|
||||
}
|
||||
|
||||
void janet_printf(const char *format, ...) {
|
||||
va_list args;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatb(&buffer, format, args);
|
||||
va_end(args);
|
||||
fwrite(buffer.data, buffer.count, 1, stdout);
|
||||
janet_buffer_deinit(&buffer);
|
||||
}
|
||||
|
||||
void janet_panic(const char *message) {
|
||||
janet_panicv(janet_cstringv(message));
|
||||
}
|
||||
@@ -98,6 +136,15 @@ DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||
DEFINE_GETTER(boolean, BOOLEAN, int)
|
||||
DEFINE_GETTER(pointer, POINTER, void *)
|
||||
|
||||
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
const uint8_t *jstr = janet_getstring(argv, n);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panicf("string %v contains embedded 0s");
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
|
||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) {
|
||||
@@ -195,3 +242,38 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
}
|
||||
return range;
|
||||
}
|
||||
|
||||
Janet janet_dyn(const char *name) {
|
||||
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||
if (janet_vm_fiber->env) {
|
||||
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
void janet_setdyn(const char *name, Janet value) {
|
||||
if (!janet_vm_fiber) return;
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
|
||||
/* Some definitions for function-like macros */
|
||||
|
||||
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||
return janet_struct_head(st);
|
||||
}
|
||||
|
||||
JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
||||
return janet_abstract_head(abstract);
|
||||
}
|
||||
|
||||
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||
return janet_string_head(s);
|
||||
}
|
||||
|
||||
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||
return janet_tuple_head(tuple);
|
||||
}
|
||||
|
||||
@@ -26,6 +26,7 @@
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||
@@ -309,9 +310,9 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
||||
JanetSlot *ret = NULL;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
const JanetKV *kvs = NULL;
|
||||
int32_t cap, i, len;
|
||||
int32_t cap = 0, len = 0;
|
||||
janet_dictionary_view(ds, &kvs, &len, &cap);
|
||||
for (i = 0; i < cap; i++) {
|
||||
for (int32_t i = 0; i < cap; i++) {
|
||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
|
||||
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
|
||||
@@ -716,8 +717,12 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
|
||||
/* C Function for compiling */
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetTable *env = janet_gettable(argv, 1);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm_fiber->env = env;
|
||||
}
|
||||
const uint8_t *source = NULL;
|
||||
if (argc == 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
@@ -740,7 +745,7 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast env [, source])\n\n"
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
|
||||
1741
src/core/core.janet
1741
src/core/core.janet
File diff suppressed because it is too large
Load Diff
@@ -28,10 +28,7 @@
|
||||
#endif
|
||||
|
||||
/* Generated bytes */
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
extern const unsigned char *janet_gen_core;
|
||||
extern int32_t janet_gen_core_size;
|
||||
#else
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
extern const unsigned char *janet_core_image;
|
||||
extern size_t janet_core_image_size;
|
||||
#endif
|
||||
@@ -41,7 +38,7 @@ extern size_t janet_core_image_size;
|
||||
#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, 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>
|
||||
@@ -72,6 +69,29 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
return init;
|
||||
}
|
||||
|
||||
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
Janet value;
|
||||
if (janet_vm_fiber->env) {
|
||||
value = janet_table_get(janet_vm_fiber->env, argv[0]);
|
||||
} else {
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
if (argc == 2 && janet_checktype(value, JANET_NIL)) {
|
||||
return argv[1];
|
||||
}
|
||||
return value;
|
||||
}
|
||||
|
||||
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(2);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
@@ -91,19 +111,6 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_table(env);
|
||||
}
|
||||
|
||||
static Janet janet_core_print(int32_t argc, Janet *argv) {
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
int32_t j, len;
|
||||
const uint8_t *vstr = janet_to_string(argv[i]);
|
||||
len = janet_string_length(vstr);
|
||||
for (j = 0; j < len; ++j) {
|
||||
putc(vstr[j], stdout);
|
||||
}
|
||||
}
|
||||
putc('\n', stdout);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
@@ -266,6 +273,20 @@ static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static Janet janet_core_trace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags |= JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
@@ -276,13 +297,6 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.")
|
||||
},
|
||||
{
|
||||
"print", janet_core_print,
|
||||
JDOC("(print & xs)\n\n"
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Returns nil.")
|
||||
},
|
||||
{
|
||||
"describe", janet_core_describe,
|
||||
JDOC("(describe x)\n\n"
|
||||
@@ -422,6 +436,26 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
"dyn", janet_core_dyn,
|
||||
JDOC("(dyn key [, default=nil])\n\n"
|
||||
"Get a dynamic binding. Returns the default value if no binding found.")
|
||||
},
|
||||
{
|
||||
"setdyn", janet_core_setdyn,
|
||||
JDOC("(setdyn key value)\n\n"
|
||||
"Set a dynamic binding. Returns value.")
|
||||
},
|
||||
{
|
||||
"trace", janet_core_trace,
|
||||
JDOC("(trace func)\n\n"
|
||||
"Enable tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"untrace", janet_core_untrace,
|
||||
JDOC("(untrace func)\n\n"
|
||||
"Disables tracing on a function. Returns the function.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -619,7 +653,7 @@ static void make_apply(JanetTable *env) {
|
||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||
"f. For example:\n\n"
|
||||
"\t(apply + 1000 (range 10))\n\n"
|
||||
"sums the first 10 integers and 1000.)"));
|
||||
"sums the first 10 integers and 1000."));
|
||||
}
|
||||
|
||||
static const uint32_t error_asm[] = {
|
||||
@@ -827,12 +861,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
janet_lib_typed_array(env);
|
||||
#endif
|
||||
#ifdef JANET_INT_TYPES
|
||||
janet_lib_inttypes(env);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
/* Run bootstrap source */
|
||||
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
|
||||
#else
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
/* Unmarshal from core image */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
janet_core_image,
|
||||
|
||||
@@ -95,6 +95,7 @@ void janet_debug_find(
|
||||
* consitency with the top level code it is defined once. */
|
||||
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
int32_t fi;
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
const char *errstr = (const char *)janet_to_string(err);
|
||||
JanetFiber **fibers = NULL;
|
||||
int wrote_error = 0;
|
||||
@@ -116,43 +117,43 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
if (!wrote_error) {
|
||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||
fprintf(stderr, "%s%s: %s\n",
|
||||
fprintf(out, "%s%s: %s\n",
|
||||
prefix,
|
||||
janet_status_names[status],
|
||||
errstr);
|
||||
wrote_error = 1;
|
||||
}
|
||||
|
||||
fprintf(stderr, " in");
|
||||
fprintf(out, " in");
|
||||
|
||||
if (frame->func) {
|
||||
def = frame->func->def;
|
||||
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||
fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||
if (def->source) {
|
||||
fprintf(stderr, " [%s]", (const char *)def->source);
|
||||
fprintf(out, " [%s]", (const char *)def->source);
|
||||
}
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL))
|
||||
fprintf(stderr, " %s", (const char *)janet_to_string(name));
|
||||
fprintf(out, " %s", (const char *)janet_to_string(name));
|
||||
else
|
||||
fprintf(stderr, " <cfunction>");
|
||||
fprintf(out, " <cfunction>");
|
||||
}
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||
fprintf(stderr, " (tailcall)");
|
||||
fprintf(out, " (tailcall)");
|
||||
if (frame->func && frame->pc) {
|
||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||
if (def->sourcemap) {
|
||||
JanetSourceMapping mapping = def->sourcemap[off];
|
||||
fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
|
||||
fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
|
||||
} else {
|
||||
fprintf(stderr, " pc=%d", off);
|
||||
fprintf(out, " pc=%d", off);
|
||||
}
|
||||
}
|
||||
fprintf(stderr, "\n");
|
||||
fprintf(out, "\n");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -239,11 +239,11 @@ void janetc_copy(
|
||||
return;
|
||||
}
|
||||
/* Process: src -> near -> dest */
|
||||
int32_t near = janetc_allocnear(c, JANETC_REGTEMP_3);
|
||||
janetc_movenear(c, near, src);
|
||||
janetc_moveback(c, dest, near);
|
||||
int32_t nearreg = janetc_allocnear(c, JANETC_REGTEMP_3);
|
||||
janetc_movenear(c, nearreg, src);
|
||||
janetc_moveback(c, dest, nearreg);
|
||||
/* Cleanup */
|
||||
janetc_regalloc_freetemp(&c->scope->ra, near, JANETC_REGTEMP_3);
|
||||
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||
|
||||
}
|
||||
/* Instruction templated emitters */
|
||||
|
||||
@@ -35,6 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->stacktop = JANET_FRAME_SIZE;
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||
fiber->env = NULL;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
@@ -126,6 +127,16 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||
fiber->stacktop = newtop;
|
||||
}
|
||||
|
||||
/* Create a struct with n values. If n is odd, the last value is ignored. */
|
||||
static Janet make_struct_n(const Janet *args, int32_t n) {
|
||||
int32_t i = 0;
|
||||
JanetKV *st = janet_struct_begin(n & (~1));
|
||||
for (; i < n; i += 2) {
|
||||
janet_struct_put(st, args[i], args[i + 1]);
|
||||
}
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
/* Push a stack frame to a fiber */
|
||||
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
JanetStackFrame *newframe;
|
||||
@@ -163,12 +174,19 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
/* Check varargs */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
int32_t tuplehead = fiber->frame + func->def->arity;
|
||||
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
if (tuplehead >= oldtop) {
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(NULL, 0)
|
||||
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
} else {
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
oldtop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -219,14 +237,21 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
/* Check varargs */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
int32_t tuplehead = fiber->stackstart + func->def->arity;
|
||||
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
if (tuplehead >= fiber->stacktop) {
|
||||
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
|
||||
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(NULL, 0)
|
||||
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
} else {
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
fiber->stacktop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
}
|
||||
stacksize = tuplehead - fiber->stackstart + 1;
|
||||
} else {
|
||||
@@ -291,8 +316,35 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
fiber->frame = frame->prevframe;
|
||||
}
|
||||
|
||||
JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
||||
return ((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
|
||||
}
|
||||
|
||||
JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->env ?
|
||||
janet_wrap_table(fiber->env) :
|
||||
janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||
fiber->env = NULL;
|
||||
} else {
|
||||
fiber->env = janet_gettable(argv, 1);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
@@ -333,6 +385,12 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
case 'y':
|
||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 'i':
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_vm_fiber->env;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -343,8 +401,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
||||
JANET_FIBER_STATUS_OFFSET;
|
||||
uint32_t s = janet_fiber_status(fiber);
|
||||
return janet_ckeywordv(janet_status_names[s]);
|
||||
}
|
||||
|
||||
@@ -388,7 +445,8 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal")
|
||||
"\t0-9 - block a specific user signal\n"
|
||||
"\ti - inherit the environment from the current fiber (not related to signals)")
|
||||
},
|
||||
{
|
||||
"fiber/status", cfun_fiber_status,
|
||||
@@ -420,6 +478,18 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.")
|
||||
},
|
||||
{
|
||||
"fiber/getenv", cfun_fiber_getenv,
|
||||
JDOC("(fiber/getenv fiber)\n\n"
|
||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||
"set yet.")
|
||||
},
|
||||
{
|
||||
"fiber/setenv", cfun_fiber_setenv,
|
||||
JDOC("(fiber/setenv fiber table)\n\n"
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -25,6 +25,7 @@
|
||||
#include "state.h"
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* GC State */
|
||||
@@ -107,11 +108,11 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
static void janet_mark_abstract(void *adata) {
|
||||
if (janet_gc_reachable(janet_abstract_header(adata)))
|
||||
if (janet_gc_reachable(janet_abstract_head(adata)))
|
||||
return;
|
||||
janet_gc_mark(janet_abstract_header(adata));
|
||||
if (janet_abstract_header(adata)->type->gcmark) {
|
||||
janet_abstract_header(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
||||
janet_gc_mark(janet_abstract_head(adata));
|
||||
if (janet_abstract_head(adata)->type->gcmark) {
|
||||
janet_abstract_head(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -236,6 +237,9 @@ recur:
|
||||
i = frame->prevframe;
|
||||
}
|
||||
|
||||
if (fiber->env)
|
||||
janet_mark_table(fiber->env);
|
||||
|
||||
/* Explicit tail recursion */
|
||||
if (fiber->child) {
|
||||
fiber = fiber->child;
|
||||
|
||||
386
src/core/inttypes.c
Normal file
386
src/core/inttypes.c
Normal file
@@ -0,0 +1,386 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Conditional compilation */
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
#define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */
|
||||
|
||||
static Janet it_s64_get(void *p, Janet key);
|
||||
static Janet it_u64_get(void *p, Janet key);
|
||||
|
||||
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
janet_marshal_int64(ctx, *((int64_t *)p));
|
||||
}
|
||||
|
||||
static void int64_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
*((int64_t *)p) = janet_unmarshal_int64(ctx);
|
||||
}
|
||||
|
||||
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||
char str[32];
|
||||
sprintf(str, "<core/s64 %" PRId64 ">", *((int64_t *)p));
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||
char str[32];
|
||||
sprintf(str, "<core/u64 %" PRIu64 ">", *((uint64_t *)p));
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
static const JanetAbstractType it_s64_type = {
|
||||
"core/s64",
|
||||
NULL,
|
||||
NULL,
|
||||
it_s64_get,
|
||||
NULL,
|
||||
int64_marshal,
|
||||
int64_unmarshal,
|
||||
it_s64_tostring
|
||||
};
|
||||
|
||||
static const JanetAbstractType it_u64_type = {
|
||||
"core/u64",
|
||||
NULL,
|
||||
NULL,
|
||||
it_u64_get,
|
||||
NULL,
|
||||
int64_marshal,
|
||||
int64_unmarshal,
|
||||
it_u64_tostring
|
||||
};
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
return (int64_t)dbl;
|
||||
break;
|
||||
}
|
||||
case JANET_STRING: {
|
||||
int64_t value;
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
if (janet_scan_int64(str, janet_string_length(str), &value))
|
||||
return value;
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||
(janet_abstract_type(abst) == &it_u64_type))
|
||||
return *(int64_t *)abst;
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_panic("bad s64 initializer");
|
||||
return 0;
|
||||
}
|
||||
|
||||
uint64_t janet_unwrap_u64(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
|
||||
return (uint64_t)dbl;
|
||||
break;
|
||||
}
|
||||
case JANET_STRING: {
|
||||
uint64_t value;
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
if (janet_scan_uint64(str, janet_string_length(str), &value))
|
||||
return value;
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||
(janet_abstract_type(abst) == &it_u64_type))
|
||||
return *(uint64_t *)abst;
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_panic("bad u64 initializer");
|
||||
return 0;
|
||||
}
|
||||
|
||||
JanetIntType janet_is_int(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
|
||||
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
|
||||
return (at == &it_s64_type) ? JANET_INT_S64 :
|
||||
((at == &it_u64_type) ? JANET_INT_U64 :
|
||||
JANET_INT_NONE);
|
||||
}
|
||||
|
||||
Janet janet_wrap_s64(int64_t x) {
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
*box = (int64_t)x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
Janet janet_wrap_u64(uint64_t x) {
|
||||
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
|
||||
*box = (uint64_t)x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T v1 = janet_unwrap_##type(argv[0]); \
|
||||
T v2 = janet_unwrap_##type(argv[1]); \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
COMPMETHOD(int64_t, s64, lt, <)
|
||||
COMPMETHOD(int64_t, s64, gt, >)
|
||||
COMPMETHOD(int64_t, s64, le, <=)
|
||||
COMPMETHOD(int64_t, s64, ge, >=)
|
||||
COMPMETHOD(int64_t, s64, eq, ==)
|
||||
COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
COMPMETHOD(uint64_t, u64, lt, <)
|
||||
COMPMETHOD(uint64_t, u64, gt, >)
|
||||
COMPMETHOD(uint64_t, u64, le, <=)
|
||||
COMPMETHOD(uint64_t, u64, ge, >=)
|
||||
COMPMETHOD(uint64_t, u64, eq, ==)
|
||||
COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
#undef OPMETHOD
|
||||
#undef DIVMETHOD
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"-", cfun_it_s64_sub},
|
||||
{"*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"%", cfun_it_s64_mod},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
{">=", cfun_it_s64_ge},
|
||||
{"==", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
|
||||
{"+!", cfun_it_s64_add_mut},
|
||||
{"-!", cfun_it_s64_sub_mut},
|
||||
{"*!", cfun_it_s64_mul_mut},
|
||||
{"/!", cfun_it_s64_div_mut},
|
||||
{"%!", cfun_it_s64_mod_mut},
|
||||
{"&!", cfun_it_s64_and_mut},
|
||||
{"|!", cfun_it_s64_or_mut},
|
||||
{"^!", cfun_it_s64_xor_mut},
|
||||
{"<<!", cfun_it_s64_lshift_mut},
|
||||
{">>!", cfun_it_s64_rshift_mut},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod it_u64_methods[] = {
|
||||
{"+", cfun_it_u64_add},
|
||||
{"-", cfun_it_u64_sub},
|
||||
{"*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
{">=", cfun_it_u64_ge},
|
||||
{"==", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
|
||||
{"+!", cfun_it_u64_add_mut},
|
||||
{"-!", cfun_it_u64_sub_mut},
|
||||
{"*!", cfun_it_u64_mul_mut},
|
||||
{"/!", cfun_it_u64_div_mut},
|
||||
{"%!", cfun_it_u64_mod_mut},
|
||||
{"&!", cfun_it_u64_and_mut},
|
||||
{"|!", cfun_it_u64_or_mut},
|
||||
{"^!", cfun_it_u64_xor_mut},
|
||||
{"<<!", cfun_it_u64_lshift_mut},
|
||||
{">>!", cfun_it_u64_rshift_mut},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet it_s64_get(void *p, Janet key) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
janet_panicf("expected keyword, got %v", key);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods);
|
||||
}
|
||||
|
||||
static Janet it_u64_get(void *p, Janet key) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
janet_panicf("expected keyword, got %v", key);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods);
|
||||
}
|
||||
|
||||
static const JanetReg it_cfuns[] = {
|
||||
{
|
||||
"int/s64", cfun_it_s64_new,
|
||||
JDOC("(int/s64 value)\n\n"
|
||||
"Create a boxed signed 64 bit integer from a string value.")
|
||||
},
|
||||
{
|
||||
"int/u64", cfun_it_u64_new,
|
||||
JDOC("(int/u64 value)\n\n"
|
||||
"Create a boxed unsigned 64 bit integer from a string value.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_inttypes(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, it_cfuns);
|
||||
janet_register_abstract_type(&it_s64_type);
|
||||
janet_register_abstract_type(&it_u64_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -58,6 +58,7 @@ JanetAbstractType cfun_io_filetype = {
|
||||
io_file_get,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
@@ -159,7 +160,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. Return error string if error. */
|
||||
/* Read up to n bytes into buffer. */
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||
janet_panic("file is not readable");
|
||||
@@ -182,6 +183,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
}
|
||||
int32_t bufstart = buffer->count;
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||
if (!janet_cstrcmp(sym, "all")) {
|
||||
@@ -206,6 +208,8 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
fseek(iof->file, 0, SEEK_SET);
|
||||
read_chunk(iof, buffer, (int32_t) fsize);
|
||||
}
|
||||
/* Never return nil for :all */
|
||||
return janet_wrap_buffer(buffer);
|
||||
} else if (!janet_cstrcmp(sym, "line")) {
|
||||
for (;;) {
|
||||
int x = fgetc(iof->file);
|
||||
@@ -220,6 +224,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
if (len < 0) janet_panic("expected positive integer");
|
||||
read_chunk(iof, buffer, len);
|
||||
}
|
||||
if (bufstart == buffer->count) return janet_wrap_nil();
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
@@ -332,7 +337,37 @@ static Janet io_file_get(void *p, Janet key) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
||||
}
|
||||
|
||||
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
|
||||
IOFile *iofile = abstract;
|
||||
return iofile->file;
|
||||
}
|
||||
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
FILE *f = janet_dynfile("out", stdout);
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
int32_t j, len;
|
||||
const uint8_t *vstr = janet_to_string(argv[i]);
|
||||
len = janet_string_length(vstr);
|
||||
for (j = 0; j < len; ++j) {
|
||||
putc(vstr[j], f);
|
||||
}
|
||||
}
|
||||
putc('\n', f);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"print", cfun_io_print,
|
||||
JDOC("(print & xs)\n\n"
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Returns nil.")
|
||||
},
|
||||
{
|
||||
"file/open", cfun_io_fopen,
|
||||
JDOC("(file/open path [,mode])\n\n"
|
||||
|
||||
@@ -129,7 +129,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
}
|
||||
|
||||
/* Marshal a size_t onto the buffer */
|
||||
static void pushsize(MarshalState *st, size_t x) {
|
||||
static void push64(MarshalState *st, uint64_t x) {
|
||||
if (x <= 0xF0) {
|
||||
/* Single byte */
|
||||
pushbyte(st, (uint8_t) x);
|
||||
@@ -249,6 +249,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 28)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 30)
|
||||
|
||||
/* Marshal a fiber */
|
||||
@@ -256,6 +257,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
MARSH_STACKCHECK;
|
||||
int32_t fflags = fiber->flags;
|
||||
if (fiber->child) fflags |= JANET_FIBER_FLAG_HASCHILD;
|
||||
if (fiber->env) fflags |= JANET_FIBER_FLAG_HASENV;
|
||||
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE)
|
||||
janet_panic("cannot marshal alive fiber");
|
||||
pushint(st, fflags);
|
||||
@@ -282,24 +284,31 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
j = i - JANET_FRAME_SIZE;
|
||||
i = frame->prevframe;
|
||||
}
|
||||
if (fiber->env) {
|
||||
marshal_one(st, janet_wrap_table(fiber->env), flags + 1);
|
||||
}
|
||||
if (fiber->child)
|
||||
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
|
||||
}
|
||||
|
||||
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
|
||||
janet_marshal_int64(ctx, (int64_t) value);
|
||||
}
|
||||
|
||||
void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushsize(st, value);
|
||||
};
|
||||
push64(st, (uint64_t) value);
|
||||
}
|
||||
|
||||
void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushint(st, value);
|
||||
};
|
||||
}
|
||||
|
||||
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushbyte(st, value);
|
||||
};
|
||||
}
|
||||
|
||||
void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
@@ -323,7 +332,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL};
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||
pushsize(st, janet_abstract_size(abstract));
|
||||
push64(st, (uint64_t) janet_abstract_size(abstract));
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||
@@ -579,8 +588,8 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
|
||||
}
|
||||
|
||||
/* Helper to read a size_t (up to 8 bytes unsigned). */
|
||||
static size_t readsize(UnmarshalState *st, const uint8_t **atdata) {
|
||||
size_t ret;
|
||||
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
uint64_t ret;
|
||||
const uint8_t *data = *atdata;
|
||||
MARSH_EOS(st, data);
|
||||
if (*data <= 0xF0) {
|
||||
@@ -591,7 +600,7 @@ static size_t readsize(UnmarshalState *st, const uint8_t **atdata) {
|
||||
/* Multibyte, little endian */
|
||||
int nbytes = *data - 0xF0;
|
||||
ret = 0;
|
||||
if (nbytes > 8) janet_panic("invalid size_t");
|
||||
if (nbytes > 8) janet_panic("invalid 64 bit integer");
|
||||
MARSH_EOS(st, data + nbytes);
|
||||
for (int i = nbytes; i > 0; i--)
|
||||
ret = (ret << 8) + data[i];
|
||||
@@ -837,6 +846,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->maxstack = 0;
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
|
||||
@@ -934,6 +944,15 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
janet_panic("fiber has too many stackframes");
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
@@ -949,21 +968,25 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
return data;
|
||||
}
|
||||
|
||||
void janet_unmarshal_int(JanetMarshalContext *ctx, int32_t *i) {
|
||||
int32_t janet_unmarshal_int(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
*i = readint(st, &(ctx->data));
|
||||
};
|
||||
return readint(st, &(ctx->data));
|
||||
}
|
||||
|
||||
void janet_unmarshal_size(JanetMarshalContext *ctx, size_t *i) {
|
||||
size_t janet_unmarshal_size(JanetMarshalContext *ctx) {
|
||||
return (size_t) janet_unmarshal_int64(ctx);
|
||||
}
|
||||
|
||||
int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
*i = readsize(st, &(ctx->data));
|
||||
};
|
||||
return read64(st, &(ctx->data));
|
||||
}
|
||||
|
||||
void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b) {
|
||||
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data);
|
||||
*b = *(ctx->data++);
|
||||
};
|
||||
return *(ctx->data++);
|
||||
}
|
||||
|
||||
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
@@ -972,9 +995,11 @@ void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len)
|
||||
ctx->data += len;
|
||||
}
|
||||
|
||||
void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out) {
|
||||
Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
|
||||
Janet ret;
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
ctx->data = unmarshal_one(st, ctx->data, out, ctx->flags);
|
||||
ctx->data = unmarshal_one(st, ctx->data, &ret, ctx->flags);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
|
||||
@@ -983,7 +1008,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||
if (at == NULL) return NULL;
|
||||
if (at->unmarshal) {
|
||||
void *p = janet_abstract(at, readsize(st, &data));
|
||||
void *p = janet_abstract(at, (size_t) read64(st, &data));
|
||||
JanetMarshalContext context = {NULL, st, flags, data};
|
||||
at->unmarshal(p, &context);
|
||||
*out = janet_wrap_abstract(p);
|
||||
|
||||
442
src/core/os.c
442
src/core/os.c
@@ -26,16 +26,27 @@
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#include <time.h>
|
||||
#include <fcntl.h>
|
||||
#include <errno.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <sys/stat.h>
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <Windows.h>
|
||||
#include <windows.h>
|
||||
#include <direct.h>
|
||||
#include <sys/utime.h>
|
||||
#include <io.h>
|
||||
#else
|
||||
#include <utime.h>
|
||||
#include <unistd.h>
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
#include <stdio.h>
|
||||
#endif
|
||||
|
||||
/* For macos */
|
||||
@@ -44,6 +55,12 @@
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
|
||||
#endif /* JANET_REDCUED_OS */
|
||||
|
||||
/* Core OS functions */
|
||||
|
||||
/* Full OS functions */
|
||||
|
||||
static Janet os_which(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
@@ -58,6 +75,30 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
if (argc == 0) {
|
||||
exit(EXIT_SUCCESS);
|
||||
} else if (janet_checkint(argv[0])) {
|
||||
exit(janet_unwrap_integer(argv[0]));
|
||||
} else {
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifdef JANET_REDUCED_OS
|
||||
/* Provide a dud os/getenv so init.janet works, but nothing else */
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#else
|
||||
/* Provide full os functionality */
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -124,13 +165,13 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
const uint8_t **child_argv = malloc(sizeof(uint8_t *) * (argc + 1));
|
||||
const char **child_argv = malloc(sizeof(char *) * (argc + 1));
|
||||
int status = 0;
|
||||
if (NULL == child_argv) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
child_argv[i] = janet_getstring(argv, i);
|
||||
child_argv[i] = janet_getcstring(argv, i);
|
||||
}
|
||||
child_argv[argc] = NULL;
|
||||
|
||||
@@ -139,7 +180,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
if (pid < 0) {
|
||||
janet_panic("failed to execute");
|
||||
} else if (pid == 0) {
|
||||
if (-1 == execve((const char *)child_argv[0], (char **)child_argv, NULL)) {
|
||||
if (-1 == execve(child_argv[0], (char **)child_argv, NULL)) {
|
||||
exit(1);
|
||||
}
|
||||
} else {
|
||||
@@ -153,7 +194,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? (const char *)janet_getstring(argv, 0)
|
||||
? janet_getcstring(argv, 0)
|
||||
: NULL;
|
||||
int stat = system(cmd);
|
||||
return argc
|
||||
@@ -163,10 +204,9 @@ static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const uint8_t *k = janet_getstring(argv, 0);
|
||||
const char *cstr = (const char *) k;
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
return (res && cstr)
|
||||
return res
|
||||
? janet_cstringv(res)
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
@@ -180,25 +220,11 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
#define UNSETENV(K) unsetenv(K)
|
||||
#endif
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *k = janet_getstring(argv, 0);
|
||||
const char *ks = (const char *) k;
|
||||
const char *ks = janet_getcstring(argv, 0);
|
||||
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
||||
UNSETENV(ks);
|
||||
} else {
|
||||
const uint8_t *v = janet_getstring(argv, 1);
|
||||
SETENV(ks, (const char *)v);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
if (argc == 0) {
|
||||
exit(EXIT_SUCCESS);
|
||||
} else if (janet_checkint(argv[0])) {
|
||||
exit(janet_unwrap_integer(argv[0]));
|
||||
} else {
|
||||
exit(EXIT_FAILURE);
|
||||
SETENV(ks, janet_getcstring(argv, 1));
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -301,7 +327,295 @@ static Janet os_date(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet os_link(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("os/link not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
|
||||
if (res == -1) janet_panic(strerror(errno));
|
||||
return janet_wrap_integer(res);
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = _mkdir(path);
|
||||
#else
|
||||
int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
|
||||
#endif
|
||||
return janet_wrap_boolean(res != -1);
|
||||
}
|
||||
|
||||
static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = _rmdir(path);
|
||||
#else
|
||||
int res = rmdir(path);
|
||||
#endif
|
||||
if (res == -1) janet_panic(strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_cd(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = _chdir(path);
|
||||
#else
|
||||
int res = chdir(path);
|
||||
#endif
|
||||
if (res == -1) janet_panic(strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_touch(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
struct utimbuf timebuf, *bufp;
|
||||
if (argc >= 2) {
|
||||
bufp = &timebuf;
|
||||
timebuf.actime = (time_t) janet_getnumber(argv, 1);
|
||||
if (argc >= 3) {
|
||||
timebuf.modtime = (time_t) janet_getnumber(argv, 2);
|
||||
} else {
|
||||
timebuf.modtime = timebuf.actime;
|
||||
}
|
||||
} else {
|
||||
bufp = NULL;
|
||||
}
|
||||
int res = utime(path, bufp);
|
||||
if (-1 == res) janet_panic(strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_remove(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
int status = remove(path);
|
||||
if (-1 == status) janet_panic(strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static const uint8_t *janet_decode_permissions(unsigned short m) {
|
||||
uint8_t flags[9] = {0};
|
||||
flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-';
|
||||
flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-';
|
||||
flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-';
|
||||
return janet_string(flags, sizeof(flags));
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||
const char *str = "other";
|
||||
if (m & _S_IFREG) str = "file";
|
||||
else if (m & _S_IFDIR) str = "directory";
|
||||
else if (m & _S_IFCHR) str = "character";
|
||||
return janet_ckeyword(str);
|
||||
}
|
||||
#else
|
||||
static const uint8_t *janet_decode_permissions(mode_t m) {
|
||||
uint8_t flags[9] = {0};
|
||||
flags[0] = (m & S_IRUSR) ? 'r' : '-';
|
||||
flags[1] = (m & S_IWUSR) ? 'w' : '-';
|
||||
flags[2] = (m & S_IXUSR) ? 'x' : '-';
|
||||
flags[3] = (m & S_IRGRP) ? 'r' : '-';
|
||||
flags[4] = (m & S_IWGRP) ? 'w' : '-';
|
||||
flags[5] = (m & S_IXGRP) ? 'x' : '-';
|
||||
flags[6] = (m & S_IROTH) ? 'r' : '-';
|
||||
flags[7] = (m & S_IWOTH) ? 'w' : '-';
|
||||
flags[8] = (m & S_IXOTH) ? 'x' : '-';
|
||||
return janet_string(flags, sizeof(flags));
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
const char *str = "other";
|
||||
if (S_ISREG(m)) str = "file";
|
||||
else if (S_ISDIR(m)) str = "directory";
|
||||
else if (S_ISFIFO(m)) str = "fifo";
|
||||
else if (S_ISBLK(m)) str = "block";
|
||||
else if (S_ISSOCK(m)) str = "socket";
|
||||
else if (S_ISLNK(m)) str = "link";
|
||||
else if (S_ISCHR(m)) str = "character";
|
||||
return janet_ckeyword(str);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Can we do this? */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define stat _stat
|
||||
#endif
|
||||
|
||||
/* Getters */
|
||||
static Janet os_stat_dev(struct stat *st) {
|
||||
return janet_wrap_number(st->st_dev);
|
||||
}
|
||||
static Janet os_stat_inode(struct stat *st) {
|
||||
return janet_wrap_number(st->st_ino);
|
||||
}
|
||||
static Janet os_stat_mode(struct stat *st) {
|
||||
return janet_wrap_keyword(janet_decode_mode(st->st_mode));
|
||||
}
|
||||
static Janet os_stat_permissions(struct stat *st) {
|
||||
return janet_wrap_string(janet_decode_permissions(st->st_mode));
|
||||
}
|
||||
static Janet os_stat_uid(struct stat *st) {
|
||||
return janet_wrap_number(st->st_uid);
|
||||
}
|
||||
static Janet os_stat_gid(struct stat *st) {
|
||||
return janet_wrap_number(st->st_gid);
|
||||
}
|
||||
static Janet os_stat_nlink(struct stat *st) {
|
||||
return janet_wrap_number(st->st_nlink);
|
||||
}
|
||||
static Janet os_stat_rdev(struct stat *st) {
|
||||
return janet_wrap_number(st->st_rdev);
|
||||
}
|
||||
static Janet os_stat_size(struct stat *st) {
|
||||
return janet_wrap_number(st->st_size);
|
||||
}
|
||||
static Janet os_stat_accessed(struct stat *st) {
|
||||
return janet_wrap_number((double) st->st_atime);
|
||||
}
|
||||
static Janet os_stat_modified(struct stat *st) {
|
||||
return janet_wrap_number((double) st->st_mtime);
|
||||
}
|
||||
static Janet os_stat_changed(struct stat *st) {
|
||||
return janet_wrap_number((double) st->st_ctime);
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
static Janet os_stat_blocks(struct stat *st) {
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
static Janet os_stat_blocksize(struct stat *st) {
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
#else
|
||||
static Janet os_stat_blocks(struct stat *st) {
|
||||
return janet_wrap_number(st->st_blocks);
|
||||
}
|
||||
static Janet os_stat_blocksize(struct stat *st) {
|
||||
return janet_wrap_number(st->st_blksize);
|
||||
}
|
||||
#endif
|
||||
|
||||
struct OsStatGetter {
|
||||
const char *name;
|
||||
Janet(*fn)(struct stat *st);
|
||||
};
|
||||
|
||||
static const struct OsStatGetter os_stat_getters[] = {
|
||||
{"dev", os_stat_dev},
|
||||
{"inode", os_stat_inode},
|
||||
{"mode", os_stat_mode},
|
||||
{"permissions", os_stat_permissions},
|
||||
{"uid", os_stat_uid},
|
||||
{"gid", os_stat_gid},
|
||||
{"nlink", os_stat_nlink},
|
||||
{"rdev", os_stat_rdev},
|
||||
{"size", os_stat_size},
|
||||
{"blocks", os_stat_blocks},
|
||||
{"blocksize", os_stat_blocksize},
|
||||
{"accessed", os_stat_accessed},
|
||||
{"modified", os_stat_modified},
|
||||
{"changed", os_stat_changed},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet os_stat(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
JanetTable *tab = NULL;
|
||||
int getall = 1;
|
||||
const uint8_t *key;
|
||||
if (argc == 2) {
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
getall = 0;
|
||||
key = janet_getkeyword(argv, 1);
|
||||
} else {
|
||||
tab = janet_gettable(argv, 1);
|
||||
}
|
||||
} else {
|
||||
tab = janet_table(0);
|
||||
}
|
||||
|
||||
/* Build result */
|
||||
struct stat st;
|
||||
int res = stat(path, &st);
|
||||
if (-1 == res) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
if (getall) {
|
||||
/* Put results in table */
|
||||
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(&st));
|
||||
}
|
||||
return janet_wrap_table(tab);
|
||||
} else {
|
||||
/* Get one result */
|
||||
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||
if (janet_cstrcmp(key, sg->name)) continue;
|
||||
return sg->fn(&st);
|
||||
}
|
||||
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
|
||||
#ifdef JANET_WINDOWS
|
||||
/* Read directory items with FindFirstFile / FindNextFile / FindClose */
|
||||
struct _finddata_t afile;
|
||||
char pattern[MAX_PATH + 1];
|
||||
if (strlen(dir) > (sizeof(pattern) - 3))
|
||||
janet_panicf("path too long: %s", dir);
|
||||
sprintf(pattern, "%s/*", dir);
|
||||
intptr_t res = _findfirst(pattern, &afile);
|
||||
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
|
||||
do {
|
||||
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
||||
janet_array_push(paths, janet_cstringv(afile.name));
|
||||
}
|
||||
} while (_findnext(res, &afile) != -1);
|
||||
_findclose(res);
|
||||
#else
|
||||
/* Read directory items with opendir / readdir / closedir */
|
||||
struct dirent *dp;
|
||||
DIR *dfd = opendir(dir);
|
||||
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
|
||||
while ((dp = readdir(dfd)) != NULL) {
|
||||
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
||||
continue;
|
||||
}
|
||||
janet_array_push(paths, janet_cstringv(dp->d_name));
|
||||
}
|
||||
closedir(dfd);
|
||||
#endif
|
||||
return janet_wrap_array(paths);
|
||||
}
|
||||
|
||||
#endif /* JANET_REDUCED_OS */
|
||||
|
||||
static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/exit", os_exit,
|
||||
JDOC("(os/exit x)\n\n"
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.")
|
||||
},
|
||||
{
|
||||
"os/which", os_which,
|
||||
JDOC("(os/which)\n\n"
|
||||
@@ -310,6 +624,70 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:macos - Apple macos\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir [, array])\n\n"
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the filename or directory name and no prefix.")
|
||||
},
|
||||
{
|
||||
"os/stat", os_stat,
|
||||
JDOC("(os/stat path [, tab|key])\n\n"
|
||||
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||
"\t:dev - the device that the file is on\n"
|
||||
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
|
||||
"\t:permissions - A unix permission string like \"rwx--x--x\"\n"
|
||||
"\t:uid - File uid\n"
|
||||
"\t:gid - File gid\n"
|
||||
"\t:nlink - number of links to file\n"
|
||||
"\t:rdev - Real device of file. 0 on windows.\n"
|
||||
"\t:size - size of file in bytes\n"
|
||||
"\t:blocks - number of blocks in file. 0 on windows\n"
|
||||
"\t:blocksize - size of blocks in file. 0 on windows\n"
|
||||
"\t:accessed - timestamp when file last accessed\n"
|
||||
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
|
||||
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||
},
|
||||
{
|
||||
"os/touch", os_touch,
|
||||
JDOC("(os/touch path [, actime [, modtime]])\n\n"
|
||||
"Update the access time and modification times for a file. By default, sets "
|
||||
"times to the current time.")
|
||||
},
|
||||
{
|
||||
"os/cd", os_cd,
|
||||
JDOC("(os/cd path)\n\n"
|
||||
"Change current directory to path. Returns true on success, false on failure.")
|
||||
},
|
||||
{
|
||||
"os/mkdir", os_mkdir,
|
||||
JDOC("(os/mkdir path)\n\n"
|
||||
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||
"it will be an absolute path.")
|
||||
},
|
||||
{
|
||||
"os/rmdir", os_rmdir,
|
||||
JDOC("(os/rmdir path)\n\n"
|
||||
"Delete a directory. The directory must be empty to succeed.")
|
||||
},
|
||||
{
|
||||
"os/rm", os_remove,
|
||||
JDOC("(os/rm path)\n\n"
|
||||
"Delete a file. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/link", os_link,
|
||||
JDOC("(os/link oldpath newpath [, symlink])\n\n"
|
||||
"Create a symlink from oldpath to newpath. The 3 optional paramater "
|
||||
"enables a hard link over a soft link. Does not work on Windows.")
|
||||
},
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute program & args)\n\n"
|
||||
@@ -321,17 +699,6 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
{
|
||||
"os/exit", os_exit,
|
||||
JDOC("(os/exit x)\n\n"
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
JDOC("(os/setenv variable value)\n\n"
|
||||
@@ -367,7 +734,7 @@ static const JanetReg os_cfuns[] = {
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||
"\t:seconds - number of seconds [0-61]\n"
|
||||
"\t:minutes - number of minutes [0-59]\n"
|
||||
"\t:seconds - number of hours [0-23]\n"
|
||||
"\t:hours - number of hours [0-23]\n"
|
||||
"\t:month-day - day of month [0-30]\n"
|
||||
"\t:month - month of year [0, 11]\n"
|
||||
"\t:year - years since year 0 (e.g. 2019)\n"
|
||||
@@ -375,6 +742,7 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:year-day - day of the year [0-365]\n"
|
||||
"\t:dst - If Day Light Savings is in effect")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -257,12 +257,24 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
static int stringend(JanetParser *p, JanetParseState *state) {
|
||||
Janet ret;
|
||||
uint8_t *bufstart = p->buf;
|
||||
int32_t buflen = (int32_t) p->bufcount;
|
||||
if (state->flags & PFLAG_LONGSTRING) {
|
||||
/* Check for leading newline character so we can remove it */
|
||||
if (bufstart[0] == '\n') {
|
||||
bufstart++;
|
||||
buflen--;
|
||||
}
|
||||
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
|
||||
buflen--;
|
||||
}
|
||||
}
|
||||
if (state->flags & PFLAG_BUFFER) {
|
||||
JanetBuffer *b = janet_buffer((int32_t)p->bufcount);
|
||||
janet_buffer_push_bytes(b, p->buf, (int32_t)p->bufcount);
|
||||
JanetBuffer *b = janet_buffer(buflen);
|
||||
janet_buffer_push_bytes(b, bufstart, buflen);
|
||||
ret = janet_wrap_buffer(b);
|
||||
} else {
|
||||
ret = janet_wrap_string(janet_string(p->buf, (int32_t)p->bufcount));
|
||||
ret = janet_wrap_string(janet_string(bufstart, buflen));
|
||||
}
|
||||
p->bufcount = 0;
|
||||
popstate(p, ret);
|
||||
@@ -622,6 +634,10 @@ void janet_parser_deinit(JanetParser *parser) {
|
||||
free(parser->states);
|
||||
}
|
||||
|
||||
int janet_parser_has_more(JanetParser *parser) {
|
||||
return !!parser->pending;
|
||||
}
|
||||
|
||||
/* C functions */
|
||||
|
||||
static int parsermark(void *p, size_t size) {
|
||||
@@ -650,6 +666,7 @@ static JanetAbstractType janet_parse_parsertype = {
|
||||
parserget,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
@@ -711,7 +728,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
const uint8_t *str = janet_to_string(argv[1]);
|
||||
int32_t slen = janet_string_length(str);
|
||||
size_t newcount = p->bufcount + slen;
|
||||
if (p->bufcap > p->bufcount + slen) {
|
||||
if (p->bufcap < newcount) {
|
||||
size_t newcap = 2 * newcount;
|
||||
p->buf = realloc(p->buf, newcap);
|
||||
if (p->buf == NULL) {
|
||||
@@ -911,7 +928,7 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/eof", cfun_parse_eof,
|
||||
JDOC("(parser/insert parser)\n\n"
|
||||
JDOC("(parser/eof parser)\n\n"
|
||||
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -75,8 +75,7 @@ typedef struct {
|
||||
int32_t depth;
|
||||
enum {
|
||||
PEG_MODE_NORMAL,
|
||||
PEG_MODE_ACCUMULATE,
|
||||
PEG_MODE_NOCAPTURE
|
||||
PEG_MODE_ACCUMULATE
|
||||
} mode;
|
||||
} PegState;
|
||||
|
||||
@@ -105,10 +104,10 @@ static void cap_load(PegState *s, CapState cs) {
|
||||
|
||||
/* Add a capture */
|
||||
static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||
if (s->mode == PEG_MODE_ACCUMULATE)
|
||||
if (s->mode == PEG_MODE_ACCUMULATE) {
|
||||
janet_to_string_b(s->scratch, capture);
|
||||
if (s->mode == PEG_MODE_NORMAL ||
|
||||
(tag && s->mode == PEG_MODE_ACCUMULATE)) {
|
||||
}
|
||||
if (tag || s->mode == PEG_MODE_NORMAL) {
|
||||
janet_array_push(s->captures, capture);
|
||||
janet_buffer_push_u8(s->tags, tag);
|
||||
}
|
||||
@@ -125,8 +124,7 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||
* Post-conditions: If there is a match, returns a pointer to the next text.
|
||||
* All captures on the capture stack are valid. If there is no match,
|
||||
* returns NULL. Extra captures from successful child expressions can be
|
||||
* left on the capture stack. If s->mode was PEG_MODE_NOCAPTURE, captures MUST
|
||||
* not be changed, though.
|
||||
* left on the capture stack.
|
||||
*/
|
||||
static const uint8_t *peg_rule(
|
||||
PegState *s,
|
||||
@@ -175,12 +173,9 @@ tail:
|
||||
case RULE_LOOK: {
|
||||
text += ((int32_t *)rule)[1];
|
||||
if (text < s->text_start || text > s->text_end) return NULL;
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NOCAPTURE;
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
||||
up1(s);
|
||||
s->mode = oldmode;
|
||||
return result ? text : NULL;
|
||||
}
|
||||
|
||||
@@ -220,12 +215,9 @@ tail:
|
||||
case RULE_IFNOT: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NOCAPTURE;
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
up1(s);
|
||||
s->mode = oldmode;
|
||||
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
||||
rule = rule_b;
|
||||
goto tail;
|
||||
@@ -233,12 +225,9 @@ tail:
|
||||
|
||||
case RULE_NOT: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NOCAPTURE;
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
up1(s);
|
||||
s->mode = oldmode;
|
||||
return (result) ? NULL : text;
|
||||
}
|
||||
|
||||
@@ -301,10 +290,6 @@ tail:
|
||||
|
||||
case RULE_CAPTURE: {
|
||||
uint32_t tag = rule[2];
|
||||
if (!tag && s->mode == PEG_MODE_NOCAPTURE) {
|
||||
rule = s->bytecode + rule[1];
|
||||
goto tail;
|
||||
}
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
@@ -321,8 +306,7 @@ tail:
|
||||
case RULE_ACCUMULATE: {
|
||||
uint32_t tag = rule[2];
|
||||
int oldmode = s->mode;
|
||||
/* No capture mode, skip captures. Accumulate inside accumulate also does nothing. */
|
||||
if (!tag && oldmode != PEG_MODE_NORMAL) {
|
||||
if (!tag && oldmode == PEG_MODE_ACCUMULATE) {
|
||||
rule = s->bytecode + rule[1];
|
||||
goto tail;
|
||||
}
|
||||
@@ -333,7 +317,8 @@ tail:
|
||||
up1(s);
|
||||
s->mode = oldmode;
|
||||
if (!result) return NULL;
|
||||
Janet cap = janet_stringv(s->scratch->data + cs.scratch, s->scratch->count - cs.scratch);
|
||||
Janet cap = janet_stringv(s->scratch->data + cs.scratch,
|
||||
s->scratch->count - cs.scratch);
|
||||
cap_load(s, cs);
|
||||
pushcap(s, cap, tag);
|
||||
return result;
|
||||
@@ -352,10 +337,6 @@ tail:
|
||||
case RULE_GROUP: {
|
||||
uint32_t tag = rule[2];
|
||||
int oldmode = s->mode;
|
||||
if (!tag && oldmode == PEG_MODE_NOCAPTURE) {
|
||||
rule = s->bytecode + rule[1];
|
||||
goto tail;
|
||||
}
|
||||
CapState cs = cap_save(s);
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
down1(s);
|
||||
@@ -378,10 +359,6 @@ tail:
|
||||
case RULE_MATCHTIME: {
|
||||
uint32_t tag = rule[3];
|
||||
int oldmode = s->mode;
|
||||
if (!tag && rule[0] == RULE_REPLACE && oldmode == PEG_MODE_NOCAPTURE) {
|
||||
rule = s->bytecode + rule[1];
|
||||
goto tail;
|
||||
}
|
||||
CapState cs = cap_save(s);
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
down1(s);
|
||||
@@ -495,14 +472,14 @@ static void peg_arity(Builder *b, int32_t arity, int32_t min, int32_t max) {
|
||||
|
||||
static const uint8_t *peg_getset(Builder *b, Janet x) {
|
||||
if (!janet_checktype(x, JANET_STRING))
|
||||
peg_panicf(b, "expected string for character set");
|
||||
peg_panic(b, "expected string for character set");
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
return str;
|
||||
}
|
||||
|
||||
static const uint8_t *peg_getrange(Builder *b, Janet x) {
|
||||
if (!janet_checktype(x, JANET_STRING))
|
||||
peg_panicf(b, "expected string for character range");
|
||||
peg_panic(b, "expected string for character range");
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
if (janet_string_length(str) != 2)
|
||||
peg_panicf(b, "expected string to have length 2, got %v", x);
|
||||
@@ -541,7 +518,7 @@ static uint32_t emit_tag(Builder *b, Janet t) {
|
||||
if (janet_checktype(check, JANET_NIL)) {
|
||||
uint32_t tag = b->nexttag++;
|
||||
if (tag > 255) {
|
||||
peg_panicf(b, "too many tags - up to 255 tags are supported per peg");
|
||||
peg_panic(b, "too many tags - up to 255 tags are supported per peg");
|
||||
}
|
||||
Janet val = janet_wrap_number(tag);
|
||||
janet_table_put(b->tags, t, val);
|
||||
@@ -898,7 +875,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
|
||||
switch (janet_type(peg)) {
|
||||
default:
|
||||
peg_panicf(b, "unexpected peg source");
|
||||
peg_panic(b, "unexpected peg source");
|
||||
return 0;
|
||||
case JANET_NUMBER: {
|
||||
int32_t n = peg_getinteger(b, peg);
|
||||
@@ -919,7 +896,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
case JANET_KEYWORD: {
|
||||
Janet check = janet_table_get(b->grammar, peg);
|
||||
if (janet_checktype(check, JANET_NIL))
|
||||
peg_panicf(b, "unknown rule");
|
||||
peg_panic(b, "unknown rule");
|
||||
rule = peg_compile1(b, check);
|
||||
break;
|
||||
}
|
||||
@@ -929,7 +906,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
b->grammar = grammar;
|
||||
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
|
||||
if (janet_checktype(main_rule, JANET_NIL))
|
||||
peg_panicf(b, "grammar requires :main rule");
|
||||
peg_panic(b, "grammar requires :main rule");
|
||||
rule = peg_compile1(b, main_rule);
|
||||
b->grammar = grammar->proto;
|
||||
break;
|
||||
@@ -986,6 +963,7 @@ static JanetAbstractType peg_type = {
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
@@ -1055,7 +1033,7 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
if (argc > 2) {
|
||||
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
||||
s.extrac = argc - 3;
|
||||
s.extrav = argv + 3;
|
||||
s.extrav = janet_tuple_n(argv + 3, argc - 3);
|
||||
} else {
|
||||
start = 0;
|
||||
s.extrac = 0;
|
||||
|
||||
168
src/core/pp.c
168
src/core/pp.c
@@ -197,12 +197,24 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
case JANET_STRING:
|
||||
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
||||
return;
|
||||
case JANET_BUFFER:
|
||||
janet_escape_buffer_b(buffer, janet_unwrap_buffer(x));
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||
if (b == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(b, 5 * b->count + 3, 1);
|
||||
}
|
||||
janet_escape_buffer_b(buffer, b);
|
||||
return;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
const char *n = janet_abstract_type(janet_unwrap_abstract(x))->name;
|
||||
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
||||
void *p = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(p);
|
||||
if (at->tostring) {
|
||||
at->tostring(p, buffer);
|
||||
} else {
|
||||
const char *n = at->name;
|
||||
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
||||
}
|
||||
return;
|
||||
}
|
||||
case JANET_CFUNCTION: {
|
||||
@@ -291,6 +303,8 @@ struct pretty {
|
||||
JanetBuffer *buffer;
|
||||
int depth;
|
||||
int indent;
|
||||
int flags;
|
||||
int32_t bufstartlen;
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
@@ -306,6 +320,30 @@ static void print_newline(struct pretty *S, int just_a_space) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Color coding for types */
|
||||
static const char janet_cycle_color[] = "\x1B[36m";
|
||||
static const char *janet_pretty_colors[] = {
|
||||
"\x1B[32m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[35m",
|
||||
"\x1B[34m",
|
||||
"\x1B[33m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
"\x1B[35m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
};
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
/* Add to seen */
|
||||
@@ -318,9 +356,15 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
default: {
|
||||
Janet seenid = janet_table_get(&S->seen, x);
|
||||
if (janet_checktype(seenid, JANET_NUMBER)) {
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
||||
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||
janet_buffer_push_u8(S->buffer, '>');
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
return;
|
||||
} else {
|
||||
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
|
||||
@@ -330,13 +374,27 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
}
|
||||
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_description_b(S->buffer, x);
|
||||
default: {
|
||||
const char *color = janet_pretty_colors[janet_type(x)];
|
||||
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||
janet_buffer_push_cstring(S->buffer, color);
|
||||
}
|
||||
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
|
||||
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
|
||||
janet_buffer_push_u8(S->buffer, '@');
|
||||
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
|
||||
} else {
|
||||
janet_description_b(S->buffer, x);
|
||||
}
|
||||
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t i, len;
|
||||
const Janet *arr;
|
||||
int32_t i = 0, len = 0;
|
||||
const Janet *arr = NULL;
|
||||
int isarray = janet_checktype(x, JANET_ARRAY);
|
||||
janet_indexed_view(x, &arr, &len);
|
||||
int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR);
|
||||
@@ -348,11 +406,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
} else {
|
||||
if (!isarray && len >= 5)
|
||||
if (!isarray && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= 5) print_newline(S, 0);
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < len; i++) {
|
||||
if (i) print_newline(S, len < 5);
|
||||
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
}
|
||||
}
|
||||
@@ -385,19 +443,19 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
} else {
|
||||
int32_t i, len, cap;
|
||||
int32_t i = 0, len = 0, cap = 0;
|
||||
int first_kv_pair = 1;
|
||||
const JanetKV *kvs;
|
||||
const JanetKV *kvs = NULL;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
if (!istable && len >= 4)
|
||||
if (!istable && len >= JANET_PRETTY_DICT_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= 5) print_newline(S, 0);
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (first_kv_pair) {
|
||||
first_kv_pair = 0;
|
||||
} else {
|
||||
print_newline(S, len < 4);
|
||||
print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||
}
|
||||
janet_pretty_one(S, kvs[i].key, 0);
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
@@ -416,9 +474,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
return;
|
||||
}
|
||||
|
||||
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||
* for serialization or anything like that. */
|
||||
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
|
||||
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Janet x, int32_t startlen) {
|
||||
struct pretty S;
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_buffer(0);
|
||||
@@ -426,12 +482,20 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.flags = flags;
|
||||
S.bufstartlen = startlen;
|
||||
janet_table_init(&S.seen, 10);
|
||||
janet_pretty_one(&S, x, 0);
|
||||
janet_table_deinit(&S.seen);
|
||||
return S.buffer;
|
||||
}
|
||||
|
||||
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||
* for serialization or anything like that. */
|
||||
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static const char *typestr(Janet x) {
|
||||
JanetType t = janet_type(x);
|
||||
return (t == JANET_ABSTRACT)
|
||||
@@ -456,38 +520,18 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
||||
* Similar to printf, but specialized for operating with janet. */
|
||||
const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_list args;
|
||||
int32_t len = 0;
|
||||
int32_t i;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
JanetBuffer *bufp = &buffer;
|
||||
|
||||
/* Calculate length */
|
||||
while (format[len]) len++;
|
||||
|
||||
/* Initialize buffer */
|
||||
janet_buffer_init(bufp, len);
|
||||
|
||||
/* Start args */
|
||||
va_start(args, format);
|
||||
|
||||
/* Iterate length */
|
||||
for (i = 0; i < len; i++) {
|
||||
uint8_t c = format[i];
|
||||
switch (c) {
|
||||
void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
|
||||
for (const char *c = format; *c; c++) {
|
||||
switch (*c) {
|
||||
default:
|
||||
janet_buffer_push_u8(bufp, c);
|
||||
janet_buffer_push_u8(bufp, *c);
|
||||
break;
|
||||
case '%': {
|
||||
if (i + 1 >= len)
|
||||
if (c[1] == '\0')
|
||||
break;
|
||||
switch (format[++i]) {
|
||||
switch (*++c) {
|
||||
default:
|
||||
janet_buffer_push_u8(bufp, format[i]);
|
||||
janet_buffer_push_u8(bufp, *c);
|
||||
break;
|
||||
case 'f':
|
||||
number_to_string_b(bufp, va_arg(args, double));
|
||||
@@ -529,13 +573,36 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
||||
break;
|
||||
}
|
||||
case 'p': {
|
||||
janet_pretty(bufp, 4, va_arg(args, Janet));
|
||||
janet_pretty(bufp, 4, 0, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'P': {
|
||||
janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
||||
* Similar to printf, but specialized for operating with janet. */
|
||||
const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
|
||||
/* Calculate length, init buffer and args */
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatb(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
@@ -594,6 +661,7 @@ void janet_buffer_format(
|
||||
size_t sfl = strlen(strfrmt);
|
||||
const char *strfrmt_end = strfrmt + sfl;
|
||||
int32_t arg = argstart;
|
||||
int32_t startlen = b->count;
|
||||
while (strfrmt < strfrmt_end) {
|
||||
if (*strfrmt != '%')
|
||||
janet_buffer_push_u8(b, (uint8_t) * strfrmt++);
|
||||
@@ -642,8 +710,7 @@ void janet_buffer_format(
|
||||
if (l != (int32_t) strlen((const char *) s))
|
||||
janet_panic("string contains zeros");
|
||||
if (!strchr(form, '.') && l >= 100) {
|
||||
janet_panic
|
||||
("no precision and string is too long to be formatted");
|
||||
janet_panic("no precision and string is too long to be formatted");
|
||||
} else {
|
||||
nb = snprintf(item, MAX_ITEM, form, s);
|
||||
}
|
||||
@@ -658,11 +725,12 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
janet_pretty(b, depth, argv[arg]);
|
||||
janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "regalloc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||
|
||||
@@ -47,6 +47,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
|
||||
@@ -71,7 +71,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
}
|
||||
for (i = 0; i < len; i++)
|
||||
janet_v_push(slots, quasiquote(opts, tup[i]));
|
||||
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
|
||||
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||
? JOP_MAKE_BRACKET_TUPLE
|
||||
: JOP_MAKE_TUPLE);
|
||||
}
|
||||
case JANET_ARRAY: {
|
||||
int32_t i;
|
||||
@@ -83,7 +85,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *kv = NULL, *kvs = NULL;
|
||||
int32_t len, cap;
|
||||
int32_t len, cap = 0;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||
JanetSlot key = quasiquote(opts, kv->key);
|
||||
@@ -134,10 +136,10 @@ static int destructure(JanetCompiler *c,
|
||||
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
||||
case JANET_TUPLE:
|
||||
case JANET_ARRAY: {
|
||||
int32_t i, len;
|
||||
const Janet *values;
|
||||
int32_t len = 0;
|
||||
const Janet *values = NULL;
|
||||
janet_indexed_view(left, &values, &len);
|
||||
for (i = 0; i < len; i++) {
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
JanetSlot nextright = janetc_farslot(c);
|
||||
Janet subval = values[i];
|
||||
if (i < 0x100) {
|
||||
@@ -154,9 +156,9 @@ static int destructure(JanetCompiler *c,
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *kvs = NULL;
|
||||
int32_t i, cap, len;
|
||||
int32_t cap = 0, len = 0;
|
||||
janet_dictionary_view(left, &kvs, &len, &cap);
|
||||
for (i = 0; i < cap; i++) {
|
||||
for (int32_t i = 0; i < cap; i++) {
|
||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||
JanetSlot nextright = janetc_farslot(c);
|
||||
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
||||
@@ -172,7 +174,7 @@ static int destructure(JanetCompiler *c,
|
||||
/* Create a source map for definitions. */
|
||||
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||
Janet *tup = janet_tuple_begin(3);
|
||||
tup[0] = janet_wrap_string(c->source);
|
||||
tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil();
|
||||
tup[1] = janet_wrap_integer(c->current_mapping.start);
|
||||
tup[2] = janet_wrap_integer(c->current_mapping.end);
|
||||
return janet_tuple_end(tup);
|
||||
@@ -650,6 +652,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Function flags */
|
||||
int vararg = 0;
|
||||
int structarg = 0;
|
||||
int allow_extra = 0;
|
||||
int selfref = 0;
|
||||
int seenamp = 0;
|
||||
@@ -710,6 +713,19 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
min_arity = i;
|
||||
arity--;
|
||||
seenopt = 1;
|
||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
||||
if (seenamp) {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
structarg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else {
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
}
|
||||
@@ -747,6 +763,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
def->min_arity = min_arity;
|
||||
def->max_arity = max_arity;
|
||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
@@ -274,6 +274,26 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_integer(result);
|
||||
}
|
||||
|
||||
static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView prefix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
return str.len < prefix.len
|
||||
? janet_wrap_false()
|
||||
: janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
|
||||
}
|
||||
|
||||
static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView suffix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
return str.len < suffix.len
|
||||
? janet_wrap_false()
|
||||
: janet_wrap_boolean(memcmp(suffix.bytes,
|
||||
str.bytes + str.len - suffix.len,
|
||||
suffix.len) == 0);
|
||||
}
|
||||
|
||||
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
@@ -447,6 +467,60 @@ static Janet cfun_string_format(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(buffer->data, buffer->count);
|
||||
}
|
||||
|
||||
static int trim_help_checkset(JanetByteView set, uint8_t x) {
|
||||
for (int32_t j = 0; j < set.len; j++)
|
||||
if (set.bytes[j] == x)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int32_t trim_help_leftedge(JanetByteView str, JanetByteView set) {
|
||||
for (int32_t i = 0; i < str.len; i++)
|
||||
if (!trim_help_checkset(set, str.bytes[i]))
|
||||
return i;
|
||||
return str.len;
|
||||
}
|
||||
|
||||
static int32_t trim_help_rightedge(JanetByteView str, JanetByteView set) {
|
||||
for (int32_t i = str.len - 1; i >= 0; i--)
|
||||
if (!trim_help_checkset(set, str.bytes[i]))
|
||||
return i + 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetByteView *set) {
|
||||
janet_arity(argc, 1, 2);
|
||||
*str = janet_getbytes(argv, 0);
|
||||
if (argc >= 2) {
|
||||
*set = janet_getbytes(argv, 1);
|
||||
} else {
|
||||
set->bytes = (const uint8_t *)(" \t\r\n\v\f");
|
||||
set->len = 6;
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||
}
|
||||
|
||||
static Janet cfun_string_triml(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
return janet_stringv(str.bytes + left_edge, str.len - left_edge);
|
||||
}
|
||||
|
||||
static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
return janet_stringv(str.bytes, right_edge);
|
||||
}
|
||||
|
||||
static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/slice", cfun_string_slice,
|
||||
@@ -468,8 +542,8 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/from-bytes", cfun_string_frombytes,
|
||||
JDOC("(string/from-bytes byte-array)\n\n"
|
||||
"Creates a string from an array of integers with byte values. All integers "
|
||||
JDOC("(string/from-bytes &byte-vals)\n\n"
|
||||
"Creates a string from integer params with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
@@ -507,6 +581,16 @@ static const JanetReg string_cfuns[] = {
|
||||
"will only contribute to finding at most on occurrence of pattern. If no "
|
||||
"occurrences are found, will return an empty array.")
|
||||
},
|
||||
{
|
||||
"string/has-prefix?", cfun_string_hasprefix,
|
||||
JDOC("(string/has-prefix? pfx str)\n\n"
|
||||
"Tests whether str starts with pfx.")
|
||||
},
|
||||
{
|
||||
"string/has-suffix?", cfun_string_hassuffix,
|
||||
JDOC("(string/has-suffix? sfx str)\n\n"
|
||||
"Tests whether str ends with sfx.")
|
||||
},
|
||||
{
|
||||
"string/replace", cfun_string_replace,
|
||||
JDOC("(string/replace patt subst str)\n\n"
|
||||
@@ -544,6 +628,24 @@ static const JanetReg string_cfuns[] = {
|
||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
"string/trim", cfun_string_trim,
|
||||
JDOC("(string/trim str [,set])\n\n"
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/triml", cfun_string_triml,
|
||||
JDOC("(string/triml str [,set])\n\n"
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/trimr", cfun_string_trimr,
|
||||
JDOC("(string/trimr str [,set])\n\n"
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -45,6 +45,7 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||
@@ -290,8 +291,9 @@ int janet_scan_number(
|
||||
if (*str == '.') {
|
||||
if (seenpoint) goto error;
|
||||
seenpoint = 1;
|
||||
} else {
|
||||
seenadigit = 1;
|
||||
}
|
||||
seenadigit = 1;
|
||||
str++;
|
||||
}
|
||||
|
||||
@@ -361,3 +363,100 @@ error:
|
||||
free(mant.digits);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
static int scan_uint64(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
uint64_t *out,
|
||||
int *neg) {
|
||||
const uint8_t *end = str + len;
|
||||
int seenadigit = 0;
|
||||
int base = 10;
|
||||
*neg = 0;
|
||||
*out = 0;
|
||||
uint64_t accum = 0;
|
||||
/* len max is INT64_MAX in base 2 with _ between each bits */
|
||||
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
|
||||
/* zeros */
|
||||
if (len > 150) return 0;
|
||||
/* Get sign */
|
||||
if (str >= end) return 0;
|
||||
if (*str == '-') {
|
||||
*neg = 1;
|
||||
str++;
|
||||
} else if (*str == '+') {
|
||||
str++;
|
||||
}
|
||||
/* Check for leading 0x or digit digit r */
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) return 0;
|
||||
str += 3;
|
||||
}
|
||||
|
||||
/* Skip leading zeros */
|
||||
while (str < end && *str == '0') {
|
||||
seenadigit = 1;
|
||||
str++;
|
||||
}
|
||||
/* Parse significant digits */
|
||||
while (str < end) {
|
||||
if (*str == '_') {
|
||||
if (!seenadigit) return 0;
|
||||
} else {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= base) return 0;
|
||||
if (accum > (UINT64_MAX - digit) / base) return 0;
|
||||
accum = accum * base + digit;
|
||||
seenadigit = 1;
|
||||
}
|
||||
str++;
|
||||
}
|
||||
|
||||
if (!seenadigit) return 0;
|
||||
*out = accum;
|
||||
return 1;
|
||||
}
|
||||
|
||||
int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
if (neg && bi <= 0x8000000000000000ULL) {
|
||||
*out = -((int64_t) bi);
|
||||
return 1;
|
||||
}
|
||||
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
|
||||
*out = bi;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
if (!neg) {
|
||||
*out = bi;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -115,6 +115,23 @@ static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
Janet contents[2];
|
||||
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_start);
|
||||
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_end);
|
||||
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
janet_tuple_head(tup)->sm_start = janet_getinteger(argv, 1);
|
||||
janet_tuple_head(tup)->sm_end = janet_getinteger(argv, 2);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg tuple_cfuns[] = {
|
||||
{
|
||||
"tuple/brackets", cfun_tuple_brackets,
|
||||
@@ -138,6 +155,20 @@ static const JanetReg tuple_cfuns[] = {
|
||||
"the time, but will print differently and be treated differently by "
|
||||
"the compiler.")
|
||||
},
|
||||
{
|
||||
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||
JDOC("(tuple/sourcemap tup)\n\n"
|
||||
"Returns the sourcemap metadata attached to a tuple. "
|
||||
"The mapping is represented by a pair of byte offsets into the "
|
||||
"the source code representing the start and end byte indices where "
|
||||
"the tuple is. ")
|
||||
},
|
||||
{
|
||||
"tuple/setmap", cfun_tuple_setmap,
|
||||
JDOC("(tuple/setmap tup start end)\n\n"
|
||||
"Set the sourcemap metadata on a tuple. start and end should "
|
||||
"be integers representing byte offsets into the file. Returns tup.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -20,23 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Compiler feature test macros for things */
|
||||
#define _DEFAULT_SOURCE
|
||||
#define _BSD_SOURCE
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
typedef uint8_t ta_uint8_t;
|
||||
typedef int8_t ta_int8_t;
|
||||
typedef uint16_t ta_uint16_t;
|
||||
typedef int16_t ta_int16_t;
|
||||
typedef uint32_t ta_uint32_t;
|
||||
typedef int32_t ta_int32_t;
|
||||
typedef float ta_float32_t;
|
||||
typedef double ta_float64_t;
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
static char *ta_type_names[] = {
|
||||
"uint8",
|
||||
@@ -45,24 +34,28 @@ static char *ta_type_names[] = {
|
||||
"int16",
|
||||
"uint32",
|
||||
"int32",
|
||||
"uint64",
|
||||
"int64",
|
||||
"float32",
|
||||
"float64",
|
||||
"any"
|
||||
"?"
|
||||
};
|
||||
|
||||
static size_t ta_type_sizes[] = {
|
||||
sizeof(ta_uint8_t),
|
||||
sizeof(ta_int8_t),
|
||||
sizeof(ta_uint16_t),
|
||||
sizeof(ta_int16_t),
|
||||
sizeof(ta_uint32_t),
|
||||
sizeof(ta_int32_t),
|
||||
sizeof(ta_float32_t),
|
||||
sizeof(ta_float64_t),
|
||||
sizeof(uint8_t),
|
||||
sizeof(int8_t),
|
||||
sizeof(uint16_t),
|
||||
sizeof(int16_t),
|
||||
sizeof(uint32_t),
|
||||
sizeof(int32_t),
|
||||
sizeof(uint64_t),
|
||||
sizeof(int64_t),
|
||||
sizeof(float),
|
||||
sizeof(double),
|
||||
0
|
||||
};
|
||||
|
||||
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_float64 + 1)
|
||||
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
|
||||
#define TA_ATOM_MAXSIZE 8
|
||||
#define TA_FLAG_BIG_ENDIAN 1
|
||||
|
||||
@@ -108,10 +101,9 @@ static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
|
||||
static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||
size_t size;
|
||||
janet_unmarshal_size(ctx, &size);
|
||||
size_t size = janet_unmarshal_size(ctx);
|
||||
ta_buffer_init(buf, size);
|
||||
janet_unmarshal_int(ctx, &(buf->flags));
|
||||
buf->flags = janet_unmarshal_int(ctx);
|
||||
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||
}
|
||||
|
||||
@@ -123,6 +115,7 @@ static const JanetAbstractType ta_buffer_type = {
|
||||
NULL,
|
||||
ta_buffer_marshal,
|
||||
ta_buffer_unmarshal,
|
||||
NULL
|
||||
};
|
||||
|
||||
static int ta_mark(void *p, size_t s) {
|
||||
@@ -134,7 +127,7 @@ static int ta_mark(void *p, size_t s) {
|
||||
|
||||
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
size_t offset = (view->buffer->data - (uint8_t *)(view->data));
|
||||
size_t offset = (view->buffer->data - view->as.u8);
|
||||
janet_marshal_size(ctx, view->size);
|
||||
janet_marshal_size(ctx, view->stride);
|
||||
janet_marshal_int(ctx, view->type);
|
||||
@@ -147,197 +140,195 @@ static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
size_t offset;
|
||||
int32_t atype;
|
||||
Janet buffer;
|
||||
janet_unmarshal_size(ctx, &(view->size));
|
||||
janet_unmarshal_size(ctx, &(view->stride));
|
||||
janet_unmarshal_int(ctx, &atype);
|
||||
view->size = janet_unmarshal_size(ctx);
|
||||
view->stride = janet_unmarshal_size(ctx);
|
||||
atype = janet_unmarshal_int(ctx);
|
||||
if (atype < 0 || atype >= TA_COUNT_TYPES)
|
||||
janet_panic("bad typed array type");
|
||||
view->type = atype;
|
||||
janet_unmarshal_size(ctx, &offset);
|
||||
janet_unmarshal_janet(ctx, &buffer);
|
||||
offset = janet_unmarshal_size(ctx);
|
||||
buffer = janet_unmarshal_janet(ctx);
|
||||
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
|
||||
janet_panicf("expected typed array buffer");
|
||||
}
|
||||
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||
size_t buf_need_size = offset + (janet_tarray_type_size(view->type)) * ((view->size - 1) * view->stride + 1);
|
||||
size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
|
||||
if (view->buffer->size < buf_need_size)
|
||||
janet_panic("bad typed array offset in marshalled data");
|
||||
view->data = view->buffer->data + offset;
|
||||
view->as.u8 = view->buffer->data + offset;
|
||||
}
|
||||
|
||||
#define DEFINE_VIEW_TYPE(thetype) \
|
||||
typedef struct { \
|
||||
JanetTArrayBuffer *buffer; \
|
||||
ta_##thetype##_t *data; \
|
||||
size_t size; \
|
||||
size_t stride; \
|
||||
JanetTArrayType type; \
|
||||
} TA_View_##thetype ;
|
||||
|
||||
#define DEFINE_VIEW_GETTER(type) \
|
||||
static Janet ta_get_##type(void *p, Janet key) { \
|
||||
Janet value; \
|
||||
size_t index; \
|
||||
if (!janet_checksize(key)) \
|
||||
janet_panic("expected size as key"); \
|
||||
index = (size_t)janet_unwrap_number(key);\
|
||||
TA_View_##type *array=(TA_View_##type *)p; \
|
||||
if (index >= array->size) { \
|
||||
value = janet_wrap_nil(); \
|
||||
} else { \
|
||||
value = janet_wrap_number(array->data[index*array->stride]); \
|
||||
} \
|
||||
return value; \
|
||||
}
|
||||
|
||||
#define DEFINE_VIEW_SETTER(type) \
|
||||
void ta_put_##type(void *p, Janet key,Janet value) { \
|
||||
size_t index;\
|
||||
if (!janet_checksize(key))\
|
||||
janet_panic("expected size as key"); \
|
||||
if (!janet_checktype(value,JANET_NUMBER)) \
|
||||
janet_panic("expected number value"); \
|
||||
index = (size_t)janet_unwrap_number(key); \
|
||||
TA_View_##type *array=(TA_View_##type *)p; \
|
||||
if (index >= array->size) { \
|
||||
janet_panic("index out of bounds"); \
|
||||
} \
|
||||
array->data[index*array->stride]=(ta_##type##_t)janet_unwrap_number(value); \
|
||||
}
|
||||
|
||||
#define DEFINE_VIEW_INITIALIZER(thetype) \
|
||||
static JanetTArrayView *ta_init_##thetype(JanetTArrayView *view, \
|
||||
JanetTArrayBuffer *buf, size_t size, \
|
||||
size_t offset, size_t stride) { \
|
||||
if ((stride<1) || (size <1)) { \
|
||||
janet_panic("stride and size should be > 0"); \
|
||||
}; \
|
||||
TA_View_##thetype * tview=(TA_View_##thetype *) view; \
|
||||
size_t buf_size=offset+(sizeof(ta_##thetype##_t))*((size-1)*stride+1); \
|
||||
if (buf==NULL) { \
|
||||
buf=(JanetTArrayBuffer *)janet_abstract(&ta_buffer_type,sizeof(JanetTArrayBuffer)); \
|
||||
ta_buffer_init(buf,buf_size); \
|
||||
} \
|
||||
if (buf->size<buf_size) { \
|
||||
janet_panicf("bad buffer size, %i bytes allocated < %i required",buf->size,buf_size); \
|
||||
} \
|
||||
tview->buffer=buf; \
|
||||
tview->stride=stride; \
|
||||
tview->size=size; \
|
||||
tview->data=(ta_##thetype##_t *)(buf->data+offset); \
|
||||
tview->type=JANET_TARRAY_TYPE_##thetype; \
|
||||
return view; \
|
||||
};
|
||||
|
||||
#define BUILD_TYPE(type) \
|
||||
DEFINE_VIEW_TYPE(type) \
|
||||
DEFINE_VIEW_GETTER(type) \
|
||||
DEFINE_VIEW_SETTER(type) \
|
||||
DEFINE_VIEW_INITIALIZER(type)
|
||||
|
||||
BUILD_TYPE(uint8)
|
||||
BUILD_TYPE(int8)
|
||||
BUILD_TYPE(uint16)
|
||||
BUILD_TYPE(int16)
|
||||
BUILD_TYPE(uint32)
|
||||
BUILD_TYPE(int32)
|
||||
BUILD_TYPE(float32)
|
||||
BUILD_TYPE(float64)
|
||||
|
||||
#undef DEFINE_VIEW_TYPE
|
||||
#undef DEFINE_VIEW_GETTER
|
||||
#undef DEFINE_VIEW_SETTER
|
||||
#undef DEFINE_VIEW_INITIALIZER
|
||||
|
||||
#define DEFINE_VIEW_ABSTRACT_TYPE(type) \
|
||||
{ \
|
||||
"ta/"#type, \
|
||||
NULL, \
|
||||
ta_mark, \
|
||||
ta_get_##type, \
|
||||
ta_put_##type, \
|
||||
ta_view_marshal, \
|
||||
ta_view_unmarshal \
|
||||
}
|
||||
|
||||
static const JanetAbstractType ta_array_types[] = {
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(uint8),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(int8),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(uint16),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(int16),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(uint32),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(int32),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(float32),
|
||||
DEFINE_VIEW_ABSTRACT_TYPE(float64)
|
||||
};
|
||||
|
||||
#undef DEFINE_VIEW_ABSTRACT_TYPE
|
||||
|
||||
static int is_ta_anytype(Janet x) {
|
||||
if (janet_checktype(x, JANET_ABSTRACT)) {
|
||||
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
|
||||
for (size_t i = 0; i < TA_COUNT_TYPES; i++) {
|
||||
if (at == ta_array_types + i) return 1;
|
||||
static Janet ta_getter(void *p, Janet key) {
|
||||
Janet value;
|
||||
size_t index, i;
|
||||
JanetTArrayView *array = p;
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
i = index * array->stride;
|
||||
if (index >= array->size) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
value = janet_wrap_number(array->as.u8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
value = janet_wrap_number(array->as.s8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
value = janet_wrap_number(array->as.u16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
value = janet_wrap_number(array->as.s16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
value = janet_wrap_number(array->as.u32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
value = janet_wrap_number(array->as.s32[i]);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
value = janet_wrap_u64(array->as.u64[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
value = janet_wrap_s64(array->as.s64[i]);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
value = janet_wrap_number(array->as.f32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
value = janet_wrap_number(array->as.f64[i]);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot get from typed array of type %s",
|
||||
ta_type_names[array->type]);
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
return value;
|
||||
}
|
||||
|
||||
static int is_ta_type(Janet x, JanetTArrayType type) {
|
||||
return janet_checktype(x, JANET_ABSTRACT) &&
|
||||
(type < TA_COUNT_TYPES) &&
|
||||
(janet_abstract_type(janet_unwrap_abstract(x)) == &ta_array_types[type]);
|
||||
static void ta_setter(void *p, Janet key, Janet value) {
|
||||
size_t index, i;
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
JanetTArrayView *array = p;
|
||||
i = index * array->stride;
|
||||
if (index >= array->size) {
|
||||
janet_panic("index out of bounds");
|
||||
}
|
||||
if (!janet_checktype(value, JANET_NUMBER) &&
|
||||
array->type != JANET_TARRAY_TYPE_U64 &&
|
||||
array->type != JANET_TARRAY_TYPE_S64) {
|
||||
janet_panic("expected number value");
|
||||
}
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
array->as.s8[i] = (int8_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
array->as.s16[i] = (int16_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
array->as.s32[i] = (int32_t) janet_unwrap_number(value);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
array->as.u64[i] = janet_unwrap_u64(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
array->as.s64[i] = janet_unwrap_s64(value);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
array->as.f32[i] = (float) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
array->as.f64[i] = janet_unwrap_number(value);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot set typed array of type %s",
|
||||
ta_type_names[array->type]);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
#define CASE_TYPE_INITIALIZE(type) case JANET_TARRAY_TYPE_##type: \
|
||||
ta_init_##type(view,buffer,size,offset,stride); break
|
||||
static const JanetAbstractType ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
ta_mark,
|
||||
ta_getter,
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
NULL
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buf, size);
|
||||
return buf;
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer) {
|
||||
JanetTArrayView *view = janet_abstract(&ta_array_types[type], sizeof(JanetTArrayView));
|
||||
switch (type) {
|
||||
CASE_TYPE_INITIALIZE(uint8);
|
||||
CASE_TYPE_INITIALIZE(int8);
|
||||
CASE_TYPE_INITIALIZE(uint16);
|
||||
CASE_TYPE_INITIALIZE(int16);
|
||||
CASE_TYPE_INITIALIZE(uint32);
|
||||
CASE_TYPE_INITIALIZE(int32);
|
||||
CASE_TYPE_INITIALIZE(float32);
|
||||
CASE_TYPE_INITIALIZE(float64);
|
||||
default :
|
||||
janet_panic("bad typed array type");
|
||||
JanetTArrayView *janet_tarray_view(
|
||||
JanetTArrayType type,
|
||||
size_t size,
|
||||
size_t stride,
|
||||
size_t offset,
|
||||
JanetTArrayBuffer *buffer) {
|
||||
|
||||
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
|
||||
|
||||
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
|
||||
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
|
||||
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, buf_size);
|
||||
}
|
||||
|
||||
if (buffer->size < buf_size) {
|
||||
janet_panicf("bad buffer size, %i bytes allocated < %i required",
|
||||
buffer->size,
|
||||
buf_size);
|
||||
}
|
||||
|
||||
view->buffer = buffer;
|
||||
view->stride = stride;
|
||||
view->size = size;
|
||||
view->as.u8 = buffer->data + offset;
|
||||
view->type = type;
|
||||
|
||||
return view;
|
||||
}
|
||||
|
||||
#undef CASE_TYPE_INITIALIZE
|
||||
|
||||
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||
return (JanetTArrayBuffer *)janet_getabstract(argv, n, &ta_buffer_type);
|
||||
return janet_getabstract(argv, n, &ta_buffer_type);
|
||||
}
|
||||
|
||||
int janet_is_tarray_view(Janet x, JanetTArrayType type) {
|
||||
return (type == JANET_TARRAY_TYPE_any) ? is_ta_anytype(x) : is_ta_type(x, type);
|
||||
}
|
||||
|
||||
size_t janet_tarray_type_size(JanetTArrayType type) {
|
||||
return (type < TA_COUNT_TYPES) ? ta_type_sizes[type] : 0;
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &ta_view_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||
if (janet_is_tarray_view(argv[n], type)) {
|
||||
return (JanetTArrayView *)janet_unwrap_abstract(argv[n]);
|
||||
} else {
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
|
||||
if (view->type != type) {
|
||||
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||
n, (type <= JANET_TARRAY_TYPE_any) ? ta_type_names[type] : "?", argv[n]);
|
||||
return NULL;
|
||||
n, ta_type_names[type], argv[n]);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
@@ -353,23 +344,35 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
if (argc > 3)
|
||||
offset = janet_getsize(argv, 3);
|
||||
if (argc > 4) {
|
||||
if (is_ta_anytype(argv[4])) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[4]);
|
||||
offset = (view->buffer->data - (uint8_t *)(view->data)) + offset * ta_type_sizes[view->type];
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else {
|
||||
buffer = (JanetTArrayBuffer *)janet_getabstract(argv, 4, &ta_buffer_type);
|
||||
buffer = p;
|
||||
}
|
||||
}
|
||||
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||
return janet_wrap_abstract(view);
|
||||
}
|
||||
|
||||
static JanetTArrayView *ta_is_view(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
|
||||
return (JanetTArrayView *)abst;
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (is_ta_anytype(argv[0])) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_abstract(view->buffer);
|
||||
}
|
||||
size_t size = janet_getsize(argv, 0);
|
||||
@@ -379,8 +382,8 @@ static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (is_ta_anytype(argv[0])) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_number((double) view->size);
|
||||
}
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
|
||||
@@ -389,10 +392,11 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (is_ta_anytype(argv[0])) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
|
||||
JanetKV *props = janet_struct_begin(6);
|
||||
ptrdiff_t boffset = (uint8_t *)(view->data) - view->buffer->data;
|
||||
ptrdiff_t boffset = view->as.u8 - view->buffer->data;
|
||||
janet_struct_put(props, janet_ckeywordv("size"),
|
||||
janet_wrap_number((double) view->size));
|
||||
janet_struct_put(props, janet_ckeywordv("byte-offset"),
|
||||
@@ -419,8 +423,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
|
||||
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(argv[0]));
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetRange range;
|
||||
int32_t length = (int32_t)src->size;
|
||||
if (argc == 1) {
|
||||
@@ -438,7 +441,7 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
if (array->data) {
|
||||
for (int32_t i = range.start; i < range.end; i++) {
|
||||
array->data[i - range.start] = at->get(src, janet_wrap_number(i));
|
||||
array->data[i - range.start] = ta_getter(src, janet_wrap_number(i));
|
||||
}
|
||||
}
|
||||
array->count = range.end - range.start;
|
||||
@@ -447,17 +450,17 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||
size_t step_src = src->stride * src_atom_size;
|
||||
size_t step_dst = dst->stride * dst_atom_size;
|
||||
size_t pos_src = ((uint8_t *)(src->data) - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = ((uint8_t *)(dst->data) - dst->buffer->data) + (index_dst * step_dst);
|
||||
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||
@@ -474,17 +477,17 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||
size_t step_src = src->stride * src_atom_size;
|
||||
size_t step_dst = dst->stride * dst_atom_size;
|
||||
size_t pos_src = ((uint8_t *)(src->data) - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = ((uint8_t *)(dst->data) - dst->buffer->data) + (index_dst * step_dst);
|
||||
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||
uint8_t temp[TA_ATOM_MAXSIZE];
|
||||
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||
@@ -552,7 +555,7 @@ static const JanetReg ta_cfuns[] = {
|
||||
void janet_lib_typed_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||
janet_register_abstract_type(&ta_buffer_type);
|
||||
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||
janet_register_abstract_type(ta_array_types + i);
|
||||
}
|
||||
janet_register_abstract_type(&ta_view_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -270,12 +270,13 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
int32_t nmlen = 0;
|
||||
while (regprefix[reglen]) reglen++;
|
||||
while (cfuns->name[nmlen]) nmlen++;
|
||||
uint8_t *longname_buffer =
|
||||
janet_string_begin(reglen + 1 + nmlen);
|
||||
int32_t symlen = reglen + 1 + nmlen;
|
||||
uint8_t *longname_buffer = malloc(symlen);
|
||||
memcpy(longname_buffer, regprefix, reglen);
|
||||
longname_buffer[reglen] = '/';
|
||||
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
||||
longname = janet_wrap_symbol(janet_string_end(longname_buffer));
|
||||
longname = janet_wrap_symbol(janet_symbol(longname_buffer, symlen));
|
||||
free(longname_buffer);
|
||||
}
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
@@ -293,6 +294,7 @@ static const JanetAbstractType type_wrap = {
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
@@ -330,18 +332,18 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||
(void) p;
|
||||
Janet key = janet_csymbolv(name);
|
||||
Janet value;
|
||||
/* During boot, allow replacing core library cfunctions with values from
|
||||
/* During init, allow replacing core library cfunctions with values from
|
||||
* the env. */
|
||||
Janet check = janet_table_get(env, key);
|
||||
if (janet_checktype(check, JANET_NIL)) {
|
||||
value = x;
|
||||
} else {
|
||||
value = check;
|
||||
if (janet_checktype(check, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, value, key);
|
||||
}
|
||||
}
|
||||
janet_table_put(env, key, value);
|
||||
if (janet_checktype(value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, value, key);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
|
||||
@@ -27,6 +27,28 @@
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
exit(1);\
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
@@ -92,5 +114,8 @@ void janet_lib_peg(JanetTable *env);
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
void janet_lib_typed_array(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_INT_TYPES
|
||||
void janet_lib_inttypes(JanetTable *env);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -218,7 +218,7 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
if (type->get) {
|
||||
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||
} else {
|
||||
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||
janet_panicf("no getter for %v ", ds);
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
break;
|
||||
@@ -276,7 +276,7 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
||||
if (type->get) {
|
||||
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||
} else {
|
||||
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||
janet_panicf("no getter for %v ", ds);
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
break;
|
||||
@@ -343,7 +343,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
if (type->put) {
|
||||
(type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
|
||||
} else {
|
||||
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||
janet_panicf("no setter for %v ", ds);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -390,7 +390,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
if (type->put) {
|
||||
(type->put)(janet_unwrap_abstract(ds), key, value);
|
||||
} else {
|
||||
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||
janet_panicf("no setter for %v ", ds);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -22,6 +22,7 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Grow the buffer dynamically. Used for push operations. */
|
||||
|
||||
189
src/core/vm.c
189
src/core/vm.c
@@ -57,82 +57,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
/* How we dispatch instructions. By default, we use
|
||||
* a switch inside an infinite loop. For GCC/clang, we use
|
||||
* computed gotos. */
|
||||
#ifdef ____GNUC__
|
||||
#ifdef __GNUC__
|
||||
#define VM_START() { goto *op_lookup[first_opcode];
|
||||
#define VM_END() }
|
||||
#define VM_OP(op) label_##op :
|
||||
#define VM_DEFAULT() label_unknown_op:
|
||||
#define vm_next() goto *op_lookup[*pc & 0xFF]
|
||||
static void *op_lookup[255] = {
|
||||
&&label_JOP_NOOP,
|
||||
&&label_JOP_ERROR,
|
||||
&&label_JOP_TYPECHECK,
|
||||
&&label_JOP_RETURN,
|
||||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
&&label_JOP_BNOT,
|
||||
&&label_JOP_SHIFT_LEFT,
|
||||
&&label_JOP_SHIFT_LEFT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT,
|
||||
&&label_JOP_SHIFT_RIGHT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
|
||||
&&label_JOP_MOVE_FAR,
|
||||
&&label_JOP_MOVE_NEAR,
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
&&label_JOP_LESS_THAN_IMMEDIATE,
|
||||
&&label_JOP_EQUALS,
|
||||
&&label_JOP_EQUALS_IMMEDIATE,
|
||||
&&label_JOP_COMPARE,
|
||||
&&label_JOP_LOAD_NIL,
|
||||
&&label_JOP_LOAD_TRUE,
|
||||
&&label_JOP_LOAD_FALSE,
|
||||
&&label_JOP_LOAD_INTEGER,
|
||||
&&label_JOP_LOAD_CONSTANT,
|
||||
&&label_JOP_LOAD_UPVALUE,
|
||||
&&label_JOP_LOAD_SELF,
|
||||
&&label_JOP_SET_UPVALUE,
|
||||
&&label_JOP_CLOSURE,
|
||||
&&label_JOP_PUSH,
|
||||
&&label_JOP_PUSH_2,
|
||||
&&label_JOP_PUSH_3,
|
||||
&&label_JOP_PUSH_ARRAY,
|
||||
&&label_JOP_CALL,
|
||||
&&label_JOP_TAILCALL,
|
||||
&&label_JOP_RESUME,
|
||||
&&label_JOP_SIGNAL,
|
||||
&&label_JOP_GET,
|
||||
&&label_JOP_PUT,
|
||||
&&label_JOP_GET_INDEX,
|
||||
&&label_JOP_PUT_INDEX,
|
||||
&&label_JOP_LENGTH,
|
||||
&&label_JOP_MAKE_ARRAY,
|
||||
&&label_JOP_MAKE_BUFFER,
|
||||
&&label_JOP_MAKE_STRING,
|
||||
&&label_JOP_MAKE_STRUCT,
|
||||
&&label_JOP_MAKE_TABLE,
|
||||
&&label_JOP_MAKE_TUPLE,
|
||||
&&label_JOP_NUMERIC_LESS_THAN,
|
||||
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#define opcode (*pc & 0xFF)
|
||||
#else
|
||||
#define VM_START() uint8_t opcode = first_opcode; for (;;) {switch(opcode) {
|
||||
#define VM_END() }}
|
||||
@@ -223,6 +154,23 @@ static void *op_lookup[255] = {
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func) {
|
||||
Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
|
||||
int32_t start = janet_vm_fiber->stackstart;
|
||||
int32_t end = janet_vm_fiber->stacktop;
|
||||
int32_t argc = end - start;
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", stack[i]);
|
||||
}
|
||||
printf(")\n");
|
||||
}
|
||||
|
||||
/* Call a non function type */
|
||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||
@@ -243,6 +191,81 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||
|
||||
/* opcode -> label lookup if using clang/GCC */
|
||||
#ifdef __GNUC__
|
||||
static void *op_lookup[255] = {
|
||||
&&label_JOP_NOOP,
|
||||
&&label_JOP_ERROR,
|
||||
&&label_JOP_TYPECHECK,
|
||||
&&label_JOP_RETURN,
|
||||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
&&label_JOP_BNOT,
|
||||
&&label_JOP_SHIFT_LEFT,
|
||||
&&label_JOP_SHIFT_LEFT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT,
|
||||
&&label_JOP_SHIFT_RIGHT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
|
||||
&&label_JOP_MOVE_FAR,
|
||||
&&label_JOP_MOVE_NEAR,
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
&&label_JOP_LESS_THAN_IMMEDIATE,
|
||||
&&label_JOP_EQUALS,
|
||||
&&label_JOP_EQUALS_IMMEDIATE,
|
||||
&&label_JOP_COMPARE,
|
||||
&&label_JOP_LOAD_NIL,
|
||||
&&label_JOP_LOAD_TRUE,
|
||||
&&label_JOP_LOAD_FALSE,
|
||||
&&label_JOP_LOAD_INTEGER,
|
||||
&&label_JOP_LOAD_CONSTANT,
|
||||
&&label_JOP_LOAD_UPVALUE,
|
||||
&&label_JOP_LOAD_SELF,
|
||||
&&label_JOP_SET_UPVALUE,
|
||||
&&label_JOP_CLOSURE,
|
||||
&&label_JOP_PUSH,
|
||||
&&label_JOP_PUSH_2,
|
||||
&&label_JOP_PUSH_3,
|
||||
&&label_JOP_PUSH_ARRAY,
|
||||
&&label_JOP_CALL,
|
||||
&&label_JOP_TAILCALL,
|
||||
&&label_JOP_RESUME,
|
||||
&&label_JOP_SIGNAL,
|
||||
&&label_JOP_GET,
|
||||
&&label_JOP_PUT,
|
||||
&&label_JOP_GET_INDEX,
|
||||
&&label_JOP_PUT_INDEX,
|
||||
&&label_JOP_LENGTH,
|
||||
&&label_JOP_MAKE_ARRAY,
|
||||
&&label_JOP_MAKE_BUFFER,
|
||||
&&label_JOP_MAKE_STRING,
|
||||
&&label_JOP_MAKE_STRUCT,
|
||||
&&label_JOP_MAKE_TABLE,
|
||||
&&label_JOP_MAKE_TUPLE,
|
||||
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||
&&label_JOP_NUMERIC_LESS_THAN,
|
||||
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
|
||||
/* Interpreter state */
|
||||
register Janet *stack;
|
||||
register uint32_t *pc;
|
||||
@@ -562,6 +585,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -577,7 +601,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
|
||||
Janet ret = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
|
||||
janet_fiber_popframe(fiber);
|
||||
/*if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, ret);*/
|
||||
stack = fiber->data + fiber->frame;
|
||||
stack[A] = ret;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -598,6 +621,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -637,6 +661,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
|
||||
vm_return(sig, retreg);
|
||||
fiber->child = NULL;
|
||||
stack = fiber->data + fiber->frame;
|
||||
stack[A] = retreg;
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
@@ -681,10 +706,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
|
||||
VM_OP(JOP_MAKE_TUPLE) {
|
||||
VM_OP(JOP_MAKE_TUPLE)
|
||||
/* fallthrough */
|
||||
VM_OP(JOP_MAKE_BRACKET_TUPLE) {
|
||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||
Janet *mem = fiber->data + fiber->stackstart;
|
||||
stack[D] = janet_wrap_tuple(janet_tuple_n(mem, count));
|
||||
const Janet *tup = janet_tuple_n(mem, count);
|
||||
if (opcode == JOP_MAKE_BRACKET_TUPLE)
|
||||
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
stack[D] = janet_wrap_tuple(tup);
|
||||
fiber->stacktop = fiber->stackstart;
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
@@ -743,9 +773,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
|
||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
Janet ret;
|
||||
Janet *old_return_reg = janet_vm_return_reg;
|
||||
|
||||
/* Check entry conditions */
|
||||
if (!janet_vm_fiber)
|
||||
janet_panic("janet_call failed because there is no current fiber");
|
||||
@@ -755,14 +782,13 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Push frame */
|
||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||
janet_panicf("arity mismatch in %v", fun);
|
||||
janet_panicf("arity mismatch in %v", janet_wrap_function(fun));
|
||||
}
|
||||
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
|
||||
/* Set up */
|
||||
int32_t oldn = janet_vm_stackn++;
|
||||
int handle = janet_gclock();
|
||||
janet_vm_return_reg = &ret;
|
||||
|
||||
/* Run vm */
|
||||
JanetSignal signal = run_vm(janet_vm_fiber,
|
||||
@@ -770,13 +796,12 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
JANET_STATUS_ALIVE);
|
||||
|
||||
/* Teardown */
|
||||
janet_vm_return_reg = old_return_reg;
|
||||
janet_vm_stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) janet_panicv(ret);
|
||||
if (signal != JANET_SIGNAL_OK) janet_panicv(*janet_vm_return_reg);
|
||||
|
||||
return ret;
|
||||
return *janet_vm_return_reg;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
|
||||
141
src/core/wrap.c
141
src/core/wrap.c
@@ -22,8 +22,141 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Macro fills */
|
||||
|
||||
JanetType(janet_type)(Janet x) {
|
||||
return janet_type(x);
|
||||
}
|
||||
int (janet_checktype)(Janet x, JanetType type) {
|
||||
return janet_checktype(x, type);
|
||||
}
|
||||
int (janet_checktypes)(Janet x, int typeflags) {
|
||||
return janet_checktypes(x, typeflags);
|
||||
}
|
||||
int (janet_truthy)(Janet x) {
|
||||
return janet_truthy(x);
|
||||
}
|
||||
|
||||
const JanetKV *(janet_unwrap_struct)(Janet x) {
|
||||
return janet_unwrap_struct(x);
|
||||
}
|
||||
const Janet *(janet_unwrap_tuple)(Janet x) {
|
||||
return janet_unwrap_tuple(x);
|
||||
}
|
||||
JanetFiber *(janet_unwrap_fiber)(Janet x) {
|
||||
return janet_unwrap_fiber(x);
|
||||
}
|
||||
JanetArray *(janet_unwrap_array)(Janet x) {
|
||||
return janet_unwrap_array(x);
|
||||
}
|
||||
JanetTable *(janet_unwrap_table)(Janet x) {
|
||||
return janet_unwrap_table(x);
|
||||
}
|
||||
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
|
||||
return janet_unwrap_buffer(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_string)(Janet x) {
|
||||
return janet_unwrap_string(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_symbol)(Janet x) {
|
||||
return janet_unwrap_symbol(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_keyword)(Janet x) {
|
||||
return janet_unwrap_keyword(x);
|
||||
}
|
||||
void *(janet_unwrap_abstract)(Janet x) {
|
||||
return janet_unwrap_abstract(x);
|
||||
}
|
||||
void *(janet_unwrap_pointer)(Janet x) {
|
||||
return janet_unwrap_pointer(x);
|
||||
}
|
||||
JanetFunction *(janet_unwrap_function)(Janet x) {
|
||||
return janet_unwrap_function(x);
|
||||
}
|
||||
JanetCFunction(janet_unwrap_cfunction)(Janet x) {
|
||||
return janet_unwrap_cfunction(x);
|
||||
}
|
||||
int (janet_unwrap_boolean)(Janet x) {
|
||||
return janet_unwrap_boolean(x);
|
||||
}
|
||||
int32_t (janet_unwrap_integer)(Janet x) {
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
#if defined(JANET_NANBOX_32) || defined(JANET_NANBOX_64)
|
||||
Janet(janet_wrap_nil)(void) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
Janet(janet_wrap_true)(void) {
|
||||
return janet_wrap_true();
|
||||
}
|
||||
Janet(janet_wrap_false)(void) {
|
||||
return janet_wrap_false();
|
||||
}
|
||||
Janet(janet_wrap_boolean)(int x) {
|
||||
return janet_wrap_boolean(x);
|
||||
}
|
||||
Janet(janet_wrap_string)(const uint8_t *x) {
|
||||
return janet_wrap_string(x);
|
||||
}
|
||||
Janet(janet_wrap_symbol)(const uint8_t *x) {
|
||||
return janet_wrap_symbol(x);
|
||||
}
|
||||
Janet(janet_wrap_keyword)(const uint8_t *x) {
|
||||
return janet_wrap_keyword(x);
|
||||
}
|
||||
Janet(janet_wrap_array)(JanetArray *x) {
|
||||
return janet_wrap_array(x);
|
||||
}
|
||||
Janet(janet_wrap_tuple)(const Janet *x) {
|
||||
return janet_wrap_tuple(x);
|
||||
}
|
||||
Janet(janet_wrap_struct)(const JanetKV *x) {
|
||||
return janet_wrap_struct(x);
|
||||
}
|
||||
Janet(janet_wrap_fiber)(JanetFiber *x) {
|
||||
return janet_wrap_fiber(x);
|
||||
}
|
||||
Janet(janet_wrap_buffer)(JanetBuffer *x) {
|
||||
return janet_wrap_buffer(x);
|
||||
}
|
||||
Janet(janet_wrap_function)(JanetFunction *x) {
|
||||
return janet_wrap_function(x);
|
||||
}
|
||||
Janet(janet_wrap_cfunction)(JanetCFunction x) {
|
||||
return janet_wrap_cfunction(x);
|
||||
}
|
||||
Janet(janet_wrap_table)(JanetTable *x) {
|
||||
return janet_wrap_table(x);
|
||||
}
|
||||
Janet(janet_wrap_abstract)(void *x) {
|
||||
return janet_wrap_abstract(x);
|
||||
}
|
||||
Janet(janet_wrap_pointer)(void *x) {
|
||||
return janet_wrap_pointer(x);
|
||||
}
|
||||
Janet(janet_wrap_integer)(int32_t x) {
|
||||
return janet_wrap_integer(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NANBOX_32
|
||||
double (janet_unwrap_number)(Janet x) {
|
||||
return janet_unwrap_number(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
Janet(janet_wrap_number)(double x) {
|
||||
return janet_wrap_number(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
/*****/
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
@@ -110,13 +243,7 @@ double janet_unwrap_number(Janet x) {
|
||||
|
||||
#else
|
||||
|
||||
/* Wrapper functions wrap a data type that is used from C into a
|
||||
* janet value, which can then be used in janet internal functions. Use
|
||||
* these functions sparingly, as these function will let the programmer
|
||||
* leak memory, where as the stack based API ensures that all values can
|
||||
* be collected by the garbage collector. */
|
||||
|
||||
Janet janet_wrap_nil() {
|
||||
Janet janet_wrap_nil(void) {
|
||||
Janet y;
|
||||
y.type = JANET_NIL;
|
||||
y.as.u64 = 0;
|
||||
|
||||
@@ -29,7 +29,13 @@ extern "C" {
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#define JANET_VERSION "0.4.1"
|
||||
#include "janetconf.h"
|
||||
|
||||
#define JANET_API_VERSION 1
|
||||
|
||||
#ifndef JANET_VERSION
|
||||
#define JANET_VERSION "latest"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_BUILD
|
||||
#define JANET_BUILD "local"
|
||||
@@ -47,6 +53,7 @@ extern "C" {
|
||||
|| defined(__FreeBSD__) || defined(__DragonFly__) \
|
||||
|| defined(__FreeBSD_kernel__) \
|
||||
|| defined(__GNU__) /* GNU/Hurd */ \
|
||||
|| defined(__HAIKU__) \
|
||||
|| defined(__linux__) \
|
||||
|| defined(__NetBSD__) \
|
||||
|| defined(__OpenBSD__) \
|
||||
@@ -133,6 +140,11 @@ extern "C" {
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
|
||||
#ifndef JANET_NO_INT_TYPES
|
||||
#define JANET_INT_TYPES
|
||||
#endif
|
||||
|
||||
/* How to export symbols */
|
||||
#ifndef JANET_API
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -142,28 +154,6 @@ extern "C" {
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
exit(1);\
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Prevent some recursive functions from recursing too deeply
|
||||
* ands crashing (the parser). Instead, error out. */
|
||||
#define JANET_RECURSION_GUARD 1024
|
||||
@@ -188,20 +178,34 @@ extern "C" {
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
#else
|
||||
#elif defined(__x86_64__) || defined(_WIN64)
|
||||
/* We will only enable nanboxing by default on 64 bit systems
|
||||
* on x86. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. */
|
||||
#define JANET_NANBOX_64
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Alignment for pointers */
|
||||
#ifndef JANET_WALIGN
|
||||
#ifdef JANET_32
|
||||
#define JANET_WALIGN 4
|
||||
|
||||
/* Runtime config constants */
|
||||
#ifdef JANET_NO_NANBOX
|
||||
#define JANET_NANBOX_BIT 0
|
||||
#else
|
||||
#define JANET_WALIGN 8
|
||||
#define JANET_NANBOX_BIT 1
|
||||
#endif
|
||||
|
||||
#ifdef JANET_SINGLE_THREADED
|
||||
#define JANET_SINGLE_THREADED_BIT 1
|
||||
#else
|
||||
#define JANET_SINGLE_THREADED_BIT 0
|
||||
#endif
|
||||
|
||||
typedef struct {
|
||||
int api_version;
|
||||
int single_threaded : 1;
|
||||
int nanbox : 1;
|
||||
} JanetBuildConfig;
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
|
||||
/***** START SECTION TYPES *****/
|
||||
@@ -212,6 +216,7 @@ extern "C" {
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/* Names of all of the types */
|
||||
extern const char *const janet_type_names[16];
|
||||
@@ -335,12 +340,12 @@ typedef enum JanetType {
|
||||
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
||||
#define JANET_TFLAG_POINTER (1 << JANET_POINTER)
|
||||
|
||||
/* Some abstractions */
|
||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
||||
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
||||
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||
#define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
|
||||
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
@@ -362,6 +367,63 @@ typedef enum JanetType {
|
||||
* janet_u64(x) - get 64 bits of payload for hashing
|
||||
*/
|
||||
|
||||
/***** START SECTION NON-C API *****/
|
||||
|
||||
/* Some janet types use offset tricks to make operations easier in C. For
|
||||
* external bindings, we should prefer using the Head structs directly, and
|
||||
* use the host language to add sugar around the manipulation of the Janet types. */
|
||||
|
||||
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
|
||||
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
|
||||
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
|
||||
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
|
||||
|
||||
/* Some language bindings won't have access to the macro versions. */
|
||||
|
||||
JANET_API JanetType janet_type(Janet x);
|
||||
JANET_API int janet_checktype(Janet x, JanetType type);
|
||||
JANET_API int janet_checktypes(Janet x, int typeflags);
|
||||
JANET_API int janet_truthy(Janet x);
|
||||
|
||||
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
|
||||
JANET_API const Janet *janet_unwrap_tuple(Janet x);
|
||||
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
|
||||
JANET_API JanetArray *janet_unwrap_array(Janet x);
|
||||
JANET_API JanetTable *janet_unwrap_table(Janet x);
|
||||
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_string(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
|
||||
JANET_API void *janet_unwrap_abstract(Janet x);
|
||||
JANET_API void *janet_unwrap_pointer(Janet x);
|
||||
JANET_API JanetFunction *janet_unwrap_function(Janet x);
|
||||
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
|
||||
JANET_API int janet_unwrap_boolean(Janet x);
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
JANET_API int32_t janet_unwrap_integer(Janet x);
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
|
||||
/***** END SECTION NON-C API *****/
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
|
||||
#include <math.h>
|
||||
@@ -488,7 +550,6 @@ union Janet {
|
||||
#define janet_truthy(x) \
|
||||
((x).tagged.type != JANET_NIL && ((x).tagged.type != JANET_BOOLEAN || ((x).tagged.payload.integer & 0x1)))
|
||||
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
||||
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
@@ -526,7 +587,6 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_boolean(x) ((x).tagged.payload.integer)
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
|
||||
#else
|
||||
|
||||
@@ -564,25 +624,6 @@ struct Janet {
|
||||
#define janet_unwrap_boolean(x) ((x).as.u64 & 0x1)
|
||||
#define janet_unwrap_number(x) ((x).as.number)
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
|
||||
/* End of tagged union implementation */
|
||||
#endif
|
||||
|
||||
@@ -636,6 +677,7 @@ struct JanetFiber {
|
||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||
int32_t capacity;
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||
Janet *data;
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
};
|
||||
@@ -733,6 +775,7 @@ struct JanetAbstractHead {
|
||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||
|
||||
/* Source mapping structure for a bytecode instruction */
|
||||
@@ -777,6 +820,8 @@ struct JanetFuncEnv {
|
||||
environment is no longer on the stack. */
|
||||
};
|
||||
|
||||
#define JANET_FUNCFLAG_TRACE (1 << 16)
|
||||
|
||||
/* A function */
|
||||
struct JanetFunction {
|
||||
JanetGCObject gc;
|
||||
@@ -828,6 +873,7 @@ struct JanetAbstractType {
|
||||
void (*put)(void *data, Janet key, Janet value);
|
||||
void (*marshal)(void *p, JanetMarshalContext *ctx);
|
||||
void (*unmarshal)(void *p, JanetMarshalContext *ctx);
|
||||
void (*tostring)(void *p, JanetBuffer *buffer);
|
||||
};
|
||||
|
||||
struct JanetReg {
|
||||
@@ -960,6 +1006,7 @@ enum JanetOpCode {
|
||||
JOP_MAKE_STRUCT,
|
||||
JOP_MAKE_TABLE,
|
||||
JOP_MAKE_TUPLE,
|
||||
JOP_MAKE_BRACKET_TUPLE,
|
||||
JOP_NUMERIC_LESS_THAN,
|
||||
JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
JOP_NUMERIC_GREATER_THAN,
|
||||
@@ -984,7 +1031,7 @@ JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||
#define janet_parser_has_more(P) ((P)->pending)
|
||||
JANET_API int janet_parser_has_more(JanetParser *parser);
|
||||
|
||||
/* Assembly */
|
||||
#ifdef JANET_ASSEMBLER
|
||||
@@ -1026,6 +1073,8 @@ JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourc
|
||||
|
||||
/* Number scanning */
|
||||
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
||||
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
|
||||
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||
|
||||
/* Debugging */
|
||||
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||
@@ -1094,6 +1143,7 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
||||
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
||||
@@ -1138,7 +1188,8 @@ JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||
/* Fiber */
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
|
||||
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
|
||||
JANET_API JanetFiber *janet_current_fiber(void);
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||
@@ -1148,9 +1199,9 @@ JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key
|
||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_header(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
|
||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
||||
|
||||
/* Native */
|
||||
@@ -1187,12 +1238,15 @@ JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
||||
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
|
||||
JANET_API int janet_verify(JanetFuncDef *def);
|
||||
|
||||
/* Pretty printing */
|
||||
#define JANET_PRETTY_COLOR 1
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
JANET_API int janet_equals(Janet x, Janet y);
|
||||
JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
@@ -1223,11 +1277,20 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
/* New C API */
|
||||
|
||||
#define JANET_MODULE_ENTRY JANET_API void _janet_init
|
||||
|
||||
JANET_API int janet_api_version();
|
||||
JANET_API const JanetBuildConfig *janet_build_config();
|
||||
|
||||
#define janet_api_compatible() \
|
||||
((janet_api_build_config()->api_version == JANET_API_VERSION) \
|
||||
&& (janet_api_build_config()->nanbox == JANET_NANBOX_BIT) \
|
||||
&& (janet_api_build_config()->single_threaded == JANET_SINGLE_THREADED_BIT))
|
||||
|
||||
JANET_API void janet_panicv(Janet message);
|
||||
JANET_API void janet_panic(const char *message);
|
||||
JANET_API void janet_panics(const uint8_t *message);
|
||||
#define janet_panicf(...) janet_panics(janet_formatc(__VA_ARGS__))
|
||||
#define janet_printf(...) fputs((const char *)janet_formatc(__VA_ARGS__), stdout)
|
||||
JANET_API void janet_panicf(const char *format, ...);
|
||||
JANET_API void janet_printf(const char *format, ...);
|
||||
JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
||||
JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
|
||||
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
||||
@@ -1240,6 +1303,7 @@ JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
||||
JANET_API const JanetKV *janet_getstruct(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getstring(const Janet *argv, int32_t n);
|
||||
JANET_API const char *janet_getcstring(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getsymbol(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getkeyword(const Janet *argv, int32_t n);
|
||||
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
||||
@@ -1260,20 +1324,26 @@ JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
|
||||
/* Marshal API */
|
||||
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||
|
||||
JANET_API void janet_unmarshal_int(JanetMarshalContext *ctx, int32_t *i);
|
||||
JANET_API void janet_unmarshal_size(JanetMarshalContext *ctx, size_t *i);
|
||||
JANET_API void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b);
|
||||
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||
JANET_API void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out);
|
||||
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||
@@ -1281,15 +1351,16 @@ JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
typedef enum {
|
||||
JANET_TARRAY_TYPE_uint8,
|
||||
JANET_TARRAY_TYPE_int8,
|
||||
JANET_TARRAY_TYPE_uint16,
|
||||
JANET_TARRAY_TYPE_int16,
|
||||
JANET_TARRAY_TYPE_uint32,
|
||||
JANET_TARRAY_TYPE_int32,
|
||||
JANET_TARRAY_TYPE_float32,
|
||||
JANET_TARRAY_TYPE_float64,
|
||||
JANET_TARRAY_TYPE_any,
|
||||
JANET_TARRAY_TYPE_U8,
|
||||
JANET_TARRAY_TYPE_S8,
|
||||
JANET_TARRAY_TYPE_U16,
|
||||
JANET_TARRAY_TYPE_S16,
|
||||
JANET_TARRAY_TYPE_U32,
|
||||
JANET_TARRAY_TYPE_S32,
|
||||
JANET_TARRAY_TYPE_U64,
|
||||
JANET_TARRAY_TYPE_S64,
|
||||
JANET_TARRAY_TYPE_F32,
|
||||
JANET_TARRAY_TYPE_F64
|
||||
} JanetTArrayType;
|
||||
|
||||
typedef struct {
|
||||
@@ -1299,8 +1370,20 @@ typedef struct {
|
||||
} JanetTArrayBuffer;
|
||||
|
||||
typedef struct {
|
||||
union {
|
||||
void *pointer;
|
||||
uint8_t *u8;
|
||||
int8_t *s8;
|
||||
uint16_t *u16;
|
||||
int16_t *s16;
|
||||
uint32_t *u32;
|
||||
int32_t *s32;
|
||||
uint64_t *u64;
|
||||
int64_t *s64;
|
||||
float *f32;
|
||||
double *f64;
|
||||
} as;
|
||||
JanetTArrayBuffer *buffer;
|
||||
void *data; /* pointer inside buffer->data */
|
||||
size_t size;
|
||||
size_t stride;
|
||||
JanetTArrayType type;
|
||||
@@ -1309,9 +1392,27 @@ typedef struct {
|
||||
JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
|
||||
JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
|
||||
JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
|
||||
JANET_API size_t janet_tarray_type_size(JanetTArrayType type);
|
||||
JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
typedef enum {
|
||||
JANET_INT_NONE,
|
||||
JANET_INT_S64,
|
||||
JANET_INT_U64
|
||||
} JanetIntType;
|
||||
|
||||
JANET_API JanetIntType janet_is_int(Janet x);
|
||||
JANET_API Janet janet_wrap_s64(int64_t x);
|
||||
JANET_API Janet janet_wrap_u64(uint64_t x);
|
||||
JANET_API int64_t janet_unwrap_s64(Janet x);
|
||||
JANET_API uint64_t janet_unwrap_u64(Janet x);
|
||||
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
|
||||
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
46
src/include/janetconf.h
Normal file
46
src/include/janetconf.h
Normal file
@@ -0,0 +1,46 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Configure Janet. Edit this file to customize the build */
|
||||
|
||||
#ifndef JANETCONF_H
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION "1.0.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
/* #define JANET_SINGLE_THREADED */
|
||||
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_NO_NANBOX */
|
||||
|
||||
#endif /* end of include guard: JANETCONF_H */
|
||||
@@ -8,6 +8,8 @@
|
||||
(var *raw-stdin* false)
|
||||
(var *handleopts* true)
|
||||
(var *exit-on-error* true)
|
||||
(var *colorize* true)
|
||||
(var *compile-only* false)
|
||||
|
||||
(if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
|
||||
|
||||
@@ -24,8 +26,10 @@
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-k : Compile scripts but do not execute
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-n : Disable ANSI color output in the repl
|
||||
-l path : Execute code in a file before running the main script
|
||||
-- : Stop handling options`)
|
||||
(os/exit 0)
|
||||
@@ -35,6 +39,8 @@
|
||||
"r" (fn [&] (set *should-repl* true) 1)
|
||||
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||
"q" (fn [&] (set *quiet* true) 1)
|
||||
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||
"n" (fn [&] (set *colorize* false) 1)
|
||||
"m" (fn [i &] (set module/*syspath* (get process/args (+ i 1))) 2)
|
||||
"c" (fn [i &]
|
||||
(def e (require (get process/args (+ i 1))))
|
||||
@@ -43,7 +49,7 @@
|
||||
3)
|
||||
"-" (fn [&] (set *handleopts* false) 1)
|
||||
"l" (fn [i &]
|
||||
(import* *env* (get process/args (+ i 1))
|
||||
(import* (get process/args (+ i 1))
|
||||
:prefix "" :exit *exit-on-error*)
|
||||
2)
|
||||
"e" (fn [i &]
|
||||
@@ -64,10 +70,10 @@
|
||||
(+= i (dohandler (string/slice arg 1 2) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(import* *env* arg :prefix "" :exit *exit-on-error*)
|
||||
(import* arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
||||
(set i lenargs))))
|
||||
|
||||
(when (or *should-repl* *no-file*)
|
||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||
(if-not *quiet*
|
||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
(defn noprompt [_] "")
|
||||
@@ -83,4 +89,5 @@
|
||||
(defn getchunk [buf p]
|
||||
(getter (prompter p) buf))
|
||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||
(repl getchunk onsig)))
|
||||
|
||||
@@ -94,6 +94,7 @@ static int cols = 80;
|
||||
static char *history[JANET_HISTORY_MAX];
|
||||
static int history_count = 0;
|
||||
static int historyi = 0;
|
||||
static int sigint_flag = 0;
|
||||
static struct termios termios_start;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
@@ -333,6 +334,7 @@ static int line() {
|
||||
return 0;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
sigint_flag = 1;
|
||||
return -1;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
@@ -458,7 +460,11 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
fputc('\n', stdout);
|
||||
if (sigint_flag) {
|
||||
raise(SIGINT);
|
||||
} else {
|
||||
fputc('\n', stdout);
|
||||
}
|
||||
return;
|
||||
}
|
||||
norawmode();
|
||||
|
||||
@@ -23,6 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include "line.h"
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
extern const unsigned char *janet_gen_init;
|
||||
extern int32_t janet_gen_init_size;
|
||||
|
||||
@@ -31,6 +38,15 @@ int main(int argc, char **argv) {
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
/* Enable color console on windows 10 console. */
|
||||
#ifdef _WIN32
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
|
||||
@@ -3,9 +3,10 @@
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
|
||||
(fiber/new (fn webrepl []
|
||||
(repl (fn get-line [buf p]
|
||||
(def offset (parser/where p))
|
||||
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
||||
(repl-yield prompt buf)
|
||||
(yield)
|
||||
buf))))
|
||||
(setdyn :pretty-format "%.20P")
|
||||
(repl (fn get-line [buf p]
|
||||
(def offset (parser/where p))
|
||||
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
||||
(repl-yield prompt buf)
|
||||
(yield)
|
||||
buf))))
|
||||
|
||||
36
test/amalg/main.c
Normal file
36
test/amalg/main.c
Normal file
@@ -0,0 +1,36 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A simple client for checking if the amalgamated Janet source compiles
|
||||
* correctly. */
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
int main(int argc, const char *argv[]) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_init();
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
janet_dostring(env, "(print `hello, world!`)", "main", NULL);
|
||||
janet_deinit();
|
||||
return 0;
|
||||
}
|
||||
@@ -300,5 +300,8 @@
|
||||
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
||||
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
||||
|
||||
# Regression Test
|
||||
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -140,7 +140,7 @@
|
||||
|
||||
# Marshal
|
||||
|
||||
(def um-lookup (env-lookup *env*))
|
||||
(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
|
||||
(def m-lookup (invert um-lookup))
|
||||
|
||||
(defn testmarsh [x msg]
|
||||
@@ -182,7 +182,7 @@
|
||||
# Large functions
|
||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||
(def f (compile ['do ;manydefs] *env*))
|
||||
(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Some higher order functions and macros
|
||||
|
||||
@@ -64,6 +64,12 @@
|
||||
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
||||
(assert (= nil (string/find "" "")) "string/find 2")
|
||||
(assert (= 0 (string/find "A" "A")) "string/find 3")
|
||||
(assert (string/has-prefix? "" "foo") "string/has-prefix? 1")
|
||||
(assert (string/has-prefix? "fo" "foo") "string/has-prefix? 2")
|
||||
(assert (not (string/has-prefix? "o" "foo")) "string/has-prefix? 3")
|
||||
(assert (string/has-suffix? "" "foo") "string/has-suffix? 1")
|
||||
(assert (string/has-suffix? "oo" "foo") "string/has-suffix? 2")
|
||||
(assert (not (string/has-suffix? "f" "foo")) "string/has-suffix? 3")
|
||||
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
|
||||
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
|
||||
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
|
||||
@@ -77,6 +83,16 @@
|
||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
|
||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
|
||||
(assert (= (string/join @[] "hi") "") "string/join 4")
|
||||
(assert (= (string/trim " abcd ") "abcd") "string/trim 1")
|
||||
(assert (= (string/trim "abcd \t\t\r\f") "abcd") "string/trim 2")
|
||||
(assert (= (string/trim "\n\n\t abcd") "abcd") "string/trim 3")
|
||||
(assert (= (string/trim "") "") "string/trim 4")
|
||||
(assert (= (string/triml " abcd ") "abcd ") "string/triml 1")
|
||||
(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f") "string/triml 2")
|
||||
(assert (= (string/triml "abcd ") "abcd ") "string/triml 3")
|
||||
(assert (= (string/trimr " abcd ") " abcd") "string/trimr 1")
|
||||
(assert (= (string/trimr "\tabcd \t\t\r\f") "\tabcd") "string/trimr 2")
|
||||
(assert (= (string/trimr " abcd") " abcd") "string/trimr 3")
|
||||
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
|
||||
(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
|
||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
||||
|
||||
@@ -159,6 +159,14 @@
|
||||
(buffer/blit b2 "abcdefg" 5 6)
|
||||
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||
|
||||
# Buffer self blitting, check for use after free
|
||||
(def buf1 @"1234567890")
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(assert (= (string buf1) (string/repeat "1234567890" 16)) "buffer blit against self")
|
||||
|
||||
# Buffer push word
|
||||
|
||||
(def b3 @"")
|
||||
@@ -170,6 +178,22 @@
|
||||
(assert (= 8 (length b3)) "buffer/push-word 3")
|
||||
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
||||
|
||||
# Buffer push string
|
||||
|
||||
(def b4 (buffer/new-filled 10 0))
|
||||
(buffer/push-string b4 b4)
|
||||
(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4)) "buffer/push-buffer 1")
|
||||
(def b5 @"123")
|
||||
(buffer/push-string b5 "456" @"789")
|
||||
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
||||
|
||||
# Check for bugs with printing self with buffer/format
|
||||
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p---" buftemp)) `abcd---@"abcd"---`) "buffer/format on self 1")
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp)) `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||
|
||||
# Peg
|
||||
|
||||
(defn check-match
|
||||
@@ -351,6 +375,12 @@
|
||||
(def t (put @{} :hi 1))
|
||||
(assert (deep= t @{:hi 1}) "regression #24")
|
||||
|
||||
# Peg swallowing errors
|
||||
(assert (try (peg/match ~(/ '1 ,(fn [x] (nil x))) "x") ([err] err))
|
||||
"errors should not be swallowed")
|
||||
(assert (try ((fn [x] (nil x))) ([err] err))
|
||||
"errors should not be swallowed 2")
|
||||
|
||||
# Tuple types
|
||||
|
||||
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
|
||||
|
||||
@@ -88,4 +88,7 @@
|
||||
(assert (deep= (drop-until pos? @[-1 -2 3]) @[3]) "drop-until 4")
|
||||
(assert (deep= (drop-until pos? @[-1 1 -2]) @[1 -2]) "drop-until 5")
|
||||
|
||||
# Quasiquote bracketed tuples
|
||||
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
|
||||
|
||||
(end-suite)
|
||||
|
||||
112
test/suite6.janet
Normal file
112
test/suite6.janet
Normal file
@@ -0,0 +1,112 @@
|
||||
# Copyright (c) 2019 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(start-suite 6)
|
||||
|
||||
# some tests for bigint
|
||||
|
||||
(def i64 int/s64)
|
||||
(def u64 int/u64)
|
||||
|
||||
(assert-no-error
|
||||
"create some uint64 bigints"
|
||||
(do
|
||||
# from number
|
||||
(def a (u64 10))
|
||||
# max double we can convert to int (2^53)
|
||||
(def b (u64 0x1fffffffffffff))
|
||||
(def b (u64 (math/pow 2 53)))
|
||||
# from string
|
||||
(def c (u64 "0xffff_ffff_ffff_ffff"))
|
||||
(def c (u64 "32rvv_vv_vv_vv"))
|
||||
(def d (u64 "123456789"))))
|
||||
|
||||
(assert-no-error
|
||||
"create some int64 bigints"
|
||||
(do
|
||||
# from number
|
||||
(def a (i64 -10))
|
||||
# max double we can convert to int (2^53)
|
||||
(def b (i64 0x1fffffffffffff))
|
||||
(def b (i64 (math/pow 2 53)))
|
||||
# from string
|
||||
(def c (i64 "0x7fff_ffff_ffff_ffff"))
|
||||
(def d (i64 "123456789"))))
|
||||
|
||||
(assert-error
|
||||
"bad initializers"
|
||||
(do
|
||||
# double to big to be converted to uint64 without truncation (2^53 + 1)
|
||||
(def b (u64 (+ 0xffff_ffff_ffff_ff 1)))
|
||||
(def b (u64 (+ (math/pow 2 53) 1)))
|
||||
# out of range 65 bits
|
||||
(def c (u64 "0x1ffffffffffffffff"))
|
||||
# just to big
|
||||
(def d (u64 "123456789123456789123456789"))))
|
||||
|
||||
(assert (:== (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) "0xfffffffffffffff") "bigint operations")
|
||||
(assert (let [a (u64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations")
|
||||
|
||||
(assert-error
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# in place operators
|
||||
(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:== a 10002065535)) "in place operators")
|
||||
|
||||
# int64 typed arrays
|
||||
(assert (let [t (tarray/new :int64 10)
|
||||
b (i64 1000)]
|
||||
(set (t 0) 1000)
|
||||
(set (t 1) b)
|
||||
(set (t 2) "1000")
|
||||
(set (t 3) (t 0))
|
||||
(set (t 4) (u64 1000))
|
||||
(and
|
||||
(:== (t 0) (t 1))
|
||||
(:== (t 1) (t 2))
|
||||
(:== (t 2) (t 3))
|
||||
(:== (t 3) (t 4))
|
||||
))
|
||||
"int64 typed arrays")
|
||||
|
||||
# Dynamic bindings
|
||||
(setdyn :a 10)
|
||||
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
|
||||
(assert (= 10 (dyn :a)) "dyn usage 2")
|
||||
(assert (= nil (dyn :b)) "dyn usage 3")
|
||||
(setdyn :a 100)
|
||||
(assert (= 100 (dyn :a)) "dyn usage 4")
|
||||
|
||||
# Keyword arguments
|
||||
(defn myfn [x y z &keys {:a a :b b :c c}]
|
||||
(+ x y z a b c))
|
||||
|
||||
(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 3 :b 4 :c 5)) "keyword args 1")
|
||||
(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 1 :b 6 :c 5 :d 11)) "keyword args 2")
|
||||
|
||||
# Comment macro
|
||||
(comment 1)
|
||||
(comment 1 2)
|
||||
(comment 1 2 3)
|
||||
(comment 1 2 3 4)
|
||||
|
||||
(end-suite)
|
||||
@@ -1,76 +1,14 @@
|
||||
# Creates an amalgamated janet.c and janet.h to
|
||||
# allow for easy embedding
|
||||
# Creates an amalgamated janet.c
|
||||
|
||||
# Head
|
||||
(def {:year YY :month MM :month-day DD} (os/date))
|
||||
|
||||
(defn dofile
|
||||
"Print one file to stdout"
|
||||
[path]
|
||||
(print (slurp path)))
|
||||
|
||||
# Order is important here, as some headers
|
||||
# depend on other headers.
|
||||
(def headers
|
||||
@["src/core/util.h"
|
||||
"src/core/state.h"
|
||||
"src/core/gc.h"
|
||||
"src/core/vector.h"
|
||||
"src/core/fiber.h"
|
||||
"src/core/regalloc.h"
|
||||
"src/core/compile.h"
|
||||
"src/core/emit.h"
|
||||
"src/core/symcache.h"])
|
||||
|
||||
(def sources
|
||||
@["src/core/abstract.c"
|
||||
"src/core/array.c"
|
||||
"src/core/asm.c"
|
||||
"src/core/buffer.c"
|
||||
"src/core/bytecode.c"
|
||||
"src/core/capi.c"
|
||||
"src/core/cfuns.c"
|
||||
"src/core/compile.c"
|
||||
"src/core/corelib.c"
|
||||
"src/core/debug.c"
|
||||
"src/core/emit.c"
|
||||
"src/core/fiber.c"
|
||||
"src/core/gc.c"
|
||||
"src/core/io.c"
|
||||
"src/core/marsh.c"
|
||||
"src/core/math.c"
|
||||
"src/core/os.c"
|
||||
"src/core/parse.c"
|
||||
"src/core/peg.c"
|
||||
"src/core/pp.c"
|
||||
"src/core/regalloc.c"
|
||||
"src/core/run.c"
|
||||
"src/core/specials.c"
|
||||
"src/core/string.c"
|
||||
"src/core/strtod.c"
|
||||
"src/core/struct.c"
|
||||
"src/core/symcache.c"
|
||||
"src/core/table.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/typedarray.c"
|
||||
"src/core/util.c"
|
||||
"src/core/value.c"
|
||||
"src/core/vector.c"
|
||||
"src/core/vm.c"
|
||||
"src/core/wrap.c"])
|
||||
|
||||
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||
(print "/* Generated " YY "-" (inc MM) "-" (inc DD)
|
||||
" with janet version " janet/version "-" janet/build " */")
|
||||
|
||||
# Assume the version of janet used to run this script is the same
|
||||
# as the version being generated
|
||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||
|
||||
(print ```#define JANET_AMALG```)
|
||||
(print ```#include "janet.h"```)
|
||||
|
||||
(each h headers (dofile h))
|
||||
(each s sources (dofile s))
|
||||
|
||||
# Relies on these files being built
|
||||
(dofile "build/core_image.c")
|
||||
# Body
|
||||
(each path (tuple/slice process/args 2)
|
||||
(print (slurp path)))
|
||||
|
||||
@@ -49,7 +49,7 @@
|
||||
# Make ast from forms
|
||||
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||
|
||||
(def ctor (compile ast *env* source))
|
||||
(def ctor (compile ast (fiber/getenv (fiber/current)) source))
|
||||
(if-not (function? ctor)
|
||||
(error (string "could not compile template")))
|
||||
(ctor))
|
||||
|
||||
@@ -8,38 +8,40 @@
|
||||
(def- objext (if is-win ".obj" ".o"))
|
||||
(def- modext (if is-win ".dll" ".so"))
|
||||
|
||||
(defn- shell
|
||||
(def prefix (or (os/getenv "PREFIX") "/usr/local"))
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(print ;args)
|
||||
(def res (os/shell (string ;args)))
|
||||
(def cmd (string ;args))
|
||||
(print cmd)
|
||||
(def res (os/shell cmd))
|
||||
(unless (zero? res)
|
||||
(print "Error executing command: " ;args)
|
||||
(os/exit res)))
|
||||
|
||||
(defn- mkdir
|
||||
"Make a directory. Not safe for user code."
|
||||
[path]
|
||||
(if is-win
|
||||
(shell "mkdir " path)
|
||||
(shell "mkdir -p " path)))
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
(defn- rm
|
||||
"Remove a directory. Not safe for user code."
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if is-win
|
||||
(shell "rmdir " path " /s")
|
||||
(shell "rm -rf " path)))
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn- older-than
|
||||
[f1 f2]
|
||||
"Check if f1 is newer than f2. Used for checking if a file should be updated."
|
||||
(if is-win true
|
||||
(not (zero? (os/shell (string "[ " f1 " -nt " f2 " ]"))))))
|
||||
(defn- needs-build
|
||||
[dest src]
|
||||
"Check if dest is older than src. Used for checking if a file should be updated."
|
||||
(def f (file/open dest))
|
||||
(if (not f) (break true))
|
||||
(file/close f)
|
||||
(let [mod-dest (os/stat dest :modified)
|
||||
mod-src (os/stat src :modified)]
|
||||
(< mod-dest mod-src)))
|
||||
|
||||
(defn- older-than-some
|
||||
(defn- needs-build-some
|
||||
[f others]
|
||||
(some (partial older-than f) others))
|
||||
(some (partial needs-build f) others))
|
||||
|
||||
(defn- embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
@@ -94,14 +96,14 @@
|
||||
# Defaults
|
||||
(def OPTIMIZE 2)
|
||||
(def CC (if is-win "cl" "cc"))
|
||||
(def LD (if is-win
|
||||
"link"
|
||||
(string CC
|
||||
" -shared"
|
||||
(def LD (if is-win
|
||||
"link"
|
||||
(string CC
|
||||
" -shared"
|
||||
(if is-mac " -undefined dynamic_lookup" ""))))
|
||||
(def CFLAGS (string
|
||||
(if is-win "/I" "-I")
|
||||
module/*syspath*
|
||||
module/*headerpath*
|
||||
(if is-win " /O" " -std=c99 -Wall -Wextra -fpic -O")
|
||||
OPTIMIZE))
|
||||
|
||||
@@ -111,7 +113,7 @@
|
||||
(def cc (or (opts :compiler) CC))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def defines (interpose " " (make-defines (or (opts :defines) {}))))
|
||||
(if (older-than dest src)
|
||||
(if (needs-build dest src)
|
||||
(if is-win
|
||||
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
|
||||
(shell cc " -c " src " " ;defines " " cflags " -o " dest))))
|
||||
@@ -123,7 +125,7 @@
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def lflags (or (opts :lflags) ""))
|
||||
(def olist (string/join objects " "))
|
||||
(if (older-than-some target objects)
|
||||
(if (needs-build-some target objects)
|
||||
(if is-win
|
||||
(shell ld " /DLL /OUT:" target " " olist " %JANET_PATH%\\janet.lib")
|
||||
(shell ld " " cflags " -o " target " " olist " " lflags))))
|
||||
@@ -131,13 +133,13 @@
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(when (older-than dest source)
|
||||
(when (needs-build dest source)
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||
(file/write out
|
||||
"#include <janet/janet.h>\n"
|
||||
"#include <janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
;(interpose ", " chunks)
|
||||
"};\n\n"
|
||||
@@ -153,7 +155,7 @@
|
||||
dynamically by a janet runtime."
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(mkdir "build")
|
||||
(os/mkdir "build")
|
||||
(def sources (opt-table :source))
|
||||
(def name (opt-table :name))
|
||||
(loop [src :in sources]
|
||||
@@ -175,10 +177,14 @@
|
||||
|
||||
(defn make-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet form. This file can the be moved to any machine with
|
||||
scripts into a janet image. This file can the be moved to any machine with
|
||||
a janet vm and the required dependencies and run there."
|
||||
[& opts]
|
||||
(error "Not Yet Implemented."))
|
||||
(def opt-table (table ;opts))
|
||||
(os/mkdir "build")
|
||||
(def entry (opt-table :entry))
|
||||
(def name (opt-table :name))
|
||||
(spit (string name ".jimage") (make-image (require entry))))
|
||||
|
||||
(defn make-binary
|
||||
"Make a binary executable that can be run on the current platform. This function
|
||||
|
||||
10
tools/format.sh
Executable file
10
tools/format.sh
Executable file
@@ -0,0 +1,10 @@
|
||||
#!/bin/bash
|
||||
|
||||
# Format all code with astyle
|
||||
|
||||
STYLEOPTS="--style=attach --indent-switches --convert-tabs \
|
||||
--align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels"
|
||||
|
||||
astyle $STYLEOPTS */*.c
|
||||
astyle $STYLEOPTS */*/*.c
|
||||
astyle $STYLEOPTS */*/*.h
|
||||
@@ -74,7 +74,7 @@
|
||||
"Generate title"
|
||||
[]
|
||||
(string "<h1>Janet Core API</h1>"
|
||||
"<p>Version " janet/version "-" janet/build "</p>"
|
||||
"<p>Version " janet/version "-" janet/build "</p>"
|
||||
"<p>Generated "
|
||||
(nice-date)
|
||||
"</p>"
|
||||
@@ -103,7 +103,7 @@
|
||||
|
||||
# Generate parts and print them to stdout
|
||||
(def parts (seq [[k entry]
|
||||
:in (sort (pairs (table/getproto *env*)))
|
||||
:in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
|
||||
:when (and (get entry :doc) (not (get entry :private)))]
|
||||
(emit-item k entry)))
|
||||
(print
|
||||
|
||||
Reference in New Issue
Block a user