mirror of
https://github.com/janet-lang/janet
synced 2025-11-06 10:33:03 +00:00
Compare commits
143 Commits
threads-3
...
default-am
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1bdde9c4f7 | ||
|
|
333ae7c4f8 | ||
|
|
f7b7c83264 | ||
|
|
6f9c9879ca | ||
|
|
b8df47e063 | ||
|
|
9dad8bf56d | ||
|
|
689f2dcbb4 | ||
|
|
163e2a5b22 | ||
|
|
e36334e14b | ||
|
|
60304c7e27 | ||
|
|
28d41039b8 | ||
|
|
b8d530da36 | ||
|
|
4fad0714e7 | ||
|
|
ca17eb4a2b | ||
|
|
4fe005e3c3 | ||
|
|
2f9ed8a572 | ||
|
|
688e18a891 | ||
|
|
8162c64ca3 | ||
|
|
e179f26d50 | ||
|
|
8db68c04c4 | ||
|
|
7c92c64730 | ||
|
|
01c6ffe1d5 | ||
|
|
46f57f5c38 | ||
|
|
1ec2e08f21 | ||
|
|
77742dec11 | ||
|
|
3cb947b37e | ||
|
|
62cf407f0c | ||
|
|
bbed72f39f | ||
|
|
99c94a78d6 | ||
|
|
2dd852da54 | ||
|
|
3c87d89df3 | ||
|
|
f4ad627b54 | ||
|
|
68a5667a1a | ||
|
|
693c6d63d4 | ||
|
|
f18c3323ea | ||
|
|
f74e19e673 | ||
|
|
da70807292 | ||
|
|
9f8bc6bb8a | ||
|
|
64b9482602 | ||
|
|
8fbcae6029 | ||
|
|
064475cb8d | ||
|
|
f4077b678a | ||
|
|
51678c1aba | ||
|
|
17a2fdbf1b | ||
|
|
65d7c3eed1 | ||
|
|
41bb8c543b | ||
|
|
bbd7355313 | ||
|
|
772916593b | ||
|
|
9d8af7355f | ||
|
|
521a29446f | ||
|
|
a8e4c4bed0 | ||
|
|
6471b4d100 | ||
|
|
7f9b2b34d1 | ||
|
|
789c5f135a | ||
|
|
344f0b743d | ||
|
|
d8841de180 | ||
|
|
23c7c3bf1c | ||
|
|
3d117804dd | ||
|
|
77bb0ebe3f | ||
|
|
6d9e51e4be | ||
|
|
174ff87946 | ||
|
|
ea02b2fde9 | ||
|
|
962cd7e5f5 | ||
|
|
65be9ae095 | ||
|
|
bc2bac8cd3 | ||
|
|
b567ece401 | ||
|
|
f001b0a40c | ||
|
|
04579664fd | ||
|
|
f709d7eb40 | ||
|
|
2df8660f8b | ||
|
|
a68ee7aac6 | ||
|
|
f0e04e734c | ||
|
|
0e7cf51890 | ||
|
|
b54d9725d8 | ||
|
|
2f0570aad6 | ||
|
|
3d40c95e80 | ||
|
|
ed5027db5d | ||
|
|
c4047f3f88 | ||
|
|
ec1a06cfaf | ||
|
|
17e47a798c | ||
|
|
212aceedc6 | ||
|
|
e6f897f4ef | ||
|
|
6c7f376410 | ||
|
|
e93e237c67 | ||
|
|
a1cd759759 | ||
|
|
a2c45a697b | ||
|
|
acdbf8911c | ||
|
|
9269372768 | ||
|
|
5575e7577a | ||
|
|
ef02dacdb4 | ||
|
|
c6b639b939 | ||
|
|
0b0fb18c42 | ||
|
|
b872ee024f | ||
|
|
a15d841b5b | ||
|
|
bfb638cfc2 | ||
|
|
3a47ad5d99 | ||
|
|
e3c88295f2 | ||
|
|
75bb8fbcd1 | ||
|
|
9cb25ad7b1 | ||
|
|
f361830cb2 | ||
|
|
9dd152dc28 | ||
|
|
2ba4337e6f | ||
|
|
48fcd927ab | ||
|
|
407d8af026 | ||
|
|
d0570b55b1 | ||
|
|
a964a95c1e | ||
|
|
c2f8441572 | ||
|
|
099a957e6c | ||
|
|
a2e515ab89 | ||
|
|
2bebace8eb | ||
|
|
5142722da3 | ||
|
|
52dd0f132a | ||
|
|
022be217a2 | ||
|
|
5528bca7a9 | ||
|
|
ae474bc8d0 | ||
|
|
ddc4274314 | ||
|
|
da93a73dbd | ||
|
|
31f8778aa3 | ||
|
|
0ecd74d01d | ||
|
|
bd20b16a32 | ||
|
|
933f4b9111 | ||
|
|
3492ed6d88 | ||
|
|
e28262f5ab | ||
|
|
94246f7574 | ||
|
|
07b0ef1648 | ||
|
|
6a39c4b91d | ||
|
|
b9f0f14e31 | ||
|
|
4238379552 | ||
|
|
8cc43ad2d1 | ||
|
|
94b472df64 | ||
|
|
2b2c1ff917 | ||
|
|
c7912249b2 | ||
|
|
b8004555ea | ||
|
|
58ff7f0788 | ||
|
|
f1afc5b0b4 | ||
|
|
bc8ee207d5 | ||
|
|
76342540dc | ||
|
|
56784a34a1 | ||
|
|
eca42e98f6 | ||
|
|
c3f1b54171 | ||
|
|
9b7d642c38 | ||
|
|
f24e2f8706 | ||
|
|
aa7f3411f5 |
@@ -1,4 +1,6 @@
|
||||
image: freebsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
|
||||
@@ -1,4 +1,6 @@
|
||||
image: openbsd/6.5
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
|
||||
37
CHANGELOG.md
37
CHANGELOG.md
@@ -2,6 +2,38 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
### Unreleased
|
||||
- Remove `file/fileno` and `file/fdopen`.
|
||||
- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal
|
||||
comparison and equality functions.
|
||||
- Let abstract types define a hash function and comparison/equality semantics. This lets
|
||||
abstract types much better represent value types. This adds more fields to abstract types, which
|
||||
will generate warnings when compiled against other versions.
|
||||
- Remove Emscripten build. Instead, use the amalgamated source code with a custom toolchain.
|
||||
- Update documentation.
|
||||
- Add `var-`
|
||||
- Add `module/add-paths`
|
||||
- Add `file/temp`
|
||||
- Add `mod` function to core.
|
||||
- Small bug fixes
|
||||
- Allow signaling from C functions (yielding) via janet\_signalv. This
|
||||
makes it easy to write C functions that work with event loops, such as
|
||||
in libuv or embedded in a game.
|
||||
- Add '%j' formatting option to the format family of functions.
|
||||
- Add `defer`
|
||||
- Add `assert`
|
||||
- Add `when-with`
|
||||
- Add `if-with`
|
||||
- Add completion to the default repl based on currently defined bindings. Also generally improve
|
||||
the repl keybindings.
|
||||
- Add `eachk`
|
||||
- Add `eachp`
|
||||
- Improve functionality of the `next` function. `next` now works on many different
|
||||
types, not just tables and structs. This allows for more generic data processing.
|
||||
- Fix thread module issue where sometimes decoding a message failed.
|
||||
- Fix segfault regression when macros are called with bad arity.
|
||||
|
||||
### 1.6.0 - 2019-12-22
|
||||
- Add `thread/` module to the core.
|
||||
- Allow seeding RNGs with any sequence of bytes. This provides
|
||||
a wider key space for the RNG. Exposed in C as `janet_rng_longseed`.
|
||||
- Fix issue in `resume` and similar functions that could cause breakpoints to be skipped.
|
||||
@@ -26,6 +58,8 @@ All notable changes to this project will be documented in this file.
|
||||
- Add `janet_in` to C API.
|
||||
- Add `truthy?`
|
||||
- Add `os/environ`
|
||||
- Add `buffer/fill` and `array/fill`
|
||||
- Add `array/new-filled`
|
||||
- Use `(doc)` with no arguments to see available bindings and dynamic bindings.
|
||||
- `jpm` will use `CC` and `AR` environment variables when compiling programs.
|
||||
- Add `comptime` macro for compile time evaluation.
|
||||
@@ -33,6 +67,9 @@ All notable changes to this project will be documented in this file.
|
||||
- Add `protect` macro.
|
||||
- Add `root-env` to get the root environment table.
|
||||
- Change marshalling protocol with regard to abstract types.
|
||||
- Add `show-paths` to `jpm`.
|
||||
- Add several default patterns, like `:d` and `:s+`, to PEGs.
|
||||
- Update `jpm` path settings to make using `jpm` easier on non-global module trees.
|
||||
- Numerous small bug fixes and usability improvements.
|
||||
|
||||
### 1.5.1 - 2019-11-16
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2019 Calvin Rose and contributors
|
||||
Copyright (c) 2020 Calvin Rose and contributors
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
|
||||
126
Makefile
126
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,7 +27,7 @@ PREFIX?=/usr/local
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
@@ -37,9 +37,9 @@ MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
|
||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
LDFLAGS=-rdynamic
|
||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
@@ -67,7 +67,8 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
||||
|
||||
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
||||
|
||||
JANET_LOCAL_HEADERS=src/core/util.h \
|
||||
JANET_LOCAL_HEADERS=src/core/features.h \
|
||||
src/core/util.h \
|
||||
src/core/state.h \
|
||||
src/core/gc.h \
|
||||
src/core/vector.h \
|
||||
@@ -121,108 +122,32 @@ JANET_BOOT_SOURCES=src/boot/array_test.c \
|
||||
src/boot/number_test.c \
|
||||
src/boot/system_test.c \
|
||||
src/boot/table_test.c
|
||||
JANET_BOOT_HEADERS=src/boot/tests.h
|
||||
|
||||
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
|
||||
##########################################################
|
||||
##### The bootstrap interpreter that creates janet.c #####
|
||||
##########################################################
|
||||
|
||||
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
|
||||
|
||||
##################################################################
|
||||
##### The bootstrap interpreter that compiles the core image #####
|
||||
##################################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||
build/boot.gen.o
|
||||
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
||||
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/core_image.c: build/janet_boot
|
||||
build/janet_boot $@ JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet'
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
##########################################################
|
||||
|
||||
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
|
||||
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES))
|
||||
|
||||
# Compile the core image generated by the bootstrap build
|
||||
build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
######################
|
||||
##### Emscripten #####
|
||||
######################
|
||||
|
||||
EMCC=emcc
|
||||
EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -O2 \
|
||||
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
||||
-s ALLOW_MEMORY_GROWTH=1 \
|
||||
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
JANET_EMTARGET=build/janet.js
|
||||
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)
|
||||
JANET_EMOBJECTS=$(patsubst src/%.c,build/%.bc,$(JANET_WEB_SOURCES)) \
|
||||
build/webinit.gen.bc build/core_image.bc
|
||||
|
||||
%.gen.bc: %.gen.c
|
||||
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||
|
||||
build/core_image.bc: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||
|
||||
build/%.bc: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||
|
||||
$(JANET_EMTARGET): $(JANET_EMOBJECTS)
|
||||
$(EMCC) $(EMCFLAGS) -shared -o $@ $^
|
||||
|
||||
emscripten: $(JANET_EMTARGET)
|
||||
|
||||
#############################
|
||||
##### Generated C files #####
|
||||
#############################
|
||||
|
||||
%.gen.o: %.gen.c
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/xxd: tools/xxd.c
|
||||
$(CC) $< -o $@
|
||||
|
||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_webinit
|
||||
build/boot.gen.c: src/boot/boot.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_boot
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
|
||||
|
||||
########################
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
amalg: build/shell.c build/janet.c build/janet.h build/core_image.c build/janetconf.h
|
||||
|
||||
AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
|
||||
build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
|
||||
|
||||
AMALG_SHELL_SOURCE=src/mainclient/line.h src/mainclient/line.c src/mainclient/main.c
|
||||
build/shell.c: $(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE) > $@
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: src/include/janet.h
|
||||
cp $< $@
|
||||
@@ -230,6 +155,21 @@ build/janet.h: src/include/janet.h
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
@@ -371,5 +311,5 @@ build/embed_test: build/embed_janet.o build/embed_main.o
|
||||
test-amalg: build/embed_test
|
||||
./build/embed_test
|
||||
|
||||
.PHONY: clean install repl debug valgrind test amalg \
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest emscripten dist uninstall docs grammar format
|
||||
|
||||
14
README.md
14
README.md
@@ -21,7 +21,7 @@ janet could be embedded into other programs. Try janet in your browser at
|
||||
|
||||
## Use Cases
|
||||
|
||||
Janet makes a good system scripting language, or a language to embed in other programs. Think Lua or Guile.
|
||||
Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile.
|
||||
|
||||
## Features
|
||||
|
||||
@@ -114,15 +114,6 @@ gmake repl
|
||||
3. Run `build_win` to compile janet.
|
||||
4. Run `build_win test` to make sure everything is working.
|
||||
|
||||
### Emscripten
|
||||
|
||||
To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
|
||||
have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
|
||||
`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
|
||||
The JavaScript build is what runs the repl on the main website,
|
||||
but really serves mainly as a proof of concept. Janet will run slower in a browser.
|
||||
Building with emscripten on windows is currently unsupported.
|
||||
|
||||
### Meson
|
||||
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||
@@ -155,7 +146,8 @@ ninja -C build install
|
||||
Janet can be hacked on with pretty much any environment you like, but for IDE
|
||||
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
||||
best option, as it has excellent meson integration. It also offers code completion
|
||||
for Janet's C API right out of the box, which is very useful for exploring.
|
||||
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
|
||||
Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
|
||||
@@ -20,17 +20,17 @@ init:
|
||||
|
||||
install:
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
- choco install nsis -y -pre
|
||||
- choco install nsis -y -pre --version 3.05
|
||||
# Replace makensis.exe and files with special long string build. This should
|
||||
# prevent issues when setting PATH during installation.
|
||||
- 7z e "tools\nsis-3.04-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
- build_win all
|
||||
- refreshenv
|
||||
# We need to reload vcvars after refreshing
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
- build_win test-install
|
||||
- set janet_outname=%appveyor_repo_tag_name%
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.6.0
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.6.1
|
||||
build: off
|
||||
|
||||
artifacts:
|
||||
|
||||
68
auxbin/jpm
68
auxbin/jpm
@@ -29,7 +29,7 @@
|
||||
|
||||
(defn- rule-impl
|
||||
[target deps thunk &opt phony]
|
||||
(put (getrules) target @[(array/slice deps) thunk phony]))
|
||||
(put (getrules) target @[(array/slice deps) @[thunk] phony]))
|
||||
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
@@ -53,8 +53,9 @@
|
||||
(defn- add-thunk
|
||||
[target more]
|
||||
(def item (gettarget target))
|
||||
(def [_ thunk] item)
|
||||
(put item 1 (fn [] (more) (thunk))))
|
||||
(def [_ thunks] item)
|
||||
(array/push thunks more)
|
||||
item)
|
||||
|
||||
(defmacro add-body
|
||||
"Add recipe code to an existing rule. This makes existing rules do more but
|
||||
@@ -83,26 +84,33 @@
|
||||
(if (os/stat target :mode)
|
||||
(break target)
|
||||
(error (string "No rule for file " target " found."))))
|
||||
(def [deps thunk phony] item)
|
||||
(def [deps thunks phony] item)
|
||||
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
||||
(when (or phony (needs-build-some target realdeps))
|
||||
(thunk))
|
||||
(each thunk thunks (thunk)))
|
||||
(unless phony target))
|
||||
|
||||
#
|
||||
# Configuration
|
||||
#
|
||||
|
||||
(def- exe-dir
|
||||
"Directory containing jpm script"
|
||||
(do
|
||||
(def exe (dyn :current-file))
|
||||
(def i (last (string/find-all sep exe)))
|
||||
(slice exe 0 i)))
|
||||
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||
|
||||
# Default based on janet binary location
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/../../include/janet"))))
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/../../bin"))))
|
||||
(string exe-dir "/../include/janet")))
|
||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/.."))))
|
||||
(string exe-dir "/../lib")))
|
||||
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(string (dyn :syspath) "/bin")))
|
||||
|
||||
#
|
||||
# Compilation Defaults
|
||||
@@ -116,8 +124,6 @@
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def threads? (not (not (env 'thread/new))))
|
||||
|
||||
(print "threads " threads?)
|
||||
|
||||
# Default flags for natives, but not required
|
||||
(def default-lflags (if is-win ["/nologo"] []))
|
||||
(def default-cflags
|
||||
@@ -125,7 +131,6 @@
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
|
||||
|
||||
# Link to pthreads
|
||||
(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
|
||||
|
||||
@@ -582,16 +587,20 @@ int main(int argc, const char **argv) {
|
||||
(rm manifest)
|
||||
(print "Uninstalled."))
|
||||
|
||||
(defn- rimraf
|
||||
"Hard delete directory tree"
|
||||
[path]
|
||||
(if is-win
|
||||
# windows get rid of read-only files
|
||||
(os/shell `rmdir /S /Q "` path `"`))
|
||||
(rm path))
|
||||
|
||||
(defn clear-cache
|
||||
"Clear the global git cache."
|
||||
[]
|
||||
(def cache (find-cache))
|
||||
(print "clearing " cache "...")
|
||||
(if is-win
|
||||
# Git for windows decided that .git should be hidden and everything in it read-only.
|
||||
# This means we can't delete things easily.
|
||||
(os/shell (string `rmdir /S /Q "` cache `"`))
|
||||
(rm cache)))
|
||||
(rimraf cache))
|
||||
|
||||
(def- default-pkglist (or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
|
||||
|
||||
@@ -626,7 +635,9 @@ int main(int argc, const char **argv) {
|
||||
(when (mkdir module-dir)
|
||||
(set fresh true)
|
||||
(print "cloning repository " repo " to " module-dir)
|
||||
(os/execute ["git" "clone" repo module-dir] :p))
|
||||
(unless (zero? (os/execute ["git" "clone" repo module-dir] :p))
|
||||
(rimraf module-dir)
|
||||
(error (string "could not clone git dependency " repo))))
|
||||
(def olddir (os/cwd))
|
||||
(try
|
||||
(with-dyns [:rules @{}
|
||||
@@ -741,10 +752,11 @@ int main(int argc, const char **argv) {
|
||||
file is evaluated and a main function is looked for in the entry file. This function
|
||||
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
|
||||
This executable can be installed as well to the --binpath given."
|
||||
[&keys {:install install :name name :entry entry :headers headers}]
|
||||
[&keys {:install install :name name :entry entry :headers headers
|
||||
:cflags cflags :lflags lflags}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{} entry dest)
|
||||
(create-executable @{:cflags cflags :lflags lflags} entry dest)
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
@@ -866,6 +878,7 @@ Subcommands are:
|
||||
and install the current project.
|
||||
uninstall (module) : uninstall a module. If no module is given, uninstall the module
|
||||
defined by the current directory.
|
||||
show-paths : prints the paths that will be used to install things.
|
||||
clean : remove any generated files or artifacts
|
||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
||||
deps : install dependencies for the current project.
|
||||
@@ -896,6 +909,14 @@ Flags are:
|
||||
[]
|
||||
(print help))
|
||||
|
||||
(defn- show-paths
|
||||
[]
|
||||
(print "binpath: " (dyn :binpath JANET_BINPATH))
|
||||
(print "modpath: " (dyn :modpath JANET_MODPATH))
|
||||
(print "libpath: " (dyn :libpath JANET_LIBPATH))
|
||||
(print "headerpath: " (dyn :headerpath JANET_HEADERPATH))
|
||||
(print "syspath: " (dyn :syspath)))
|
||||
|
||||
(defn- build
|
||||
[]
|
||||
(local-rule "build"))
|
||||
@@ -947,6 +968,7 @@ Flags are:
|
||||
"test" test
|
||||
"help" help
|
||||
"deps" deps
|
||||
"show-paths" show-paths
|
||||
"clear-cache" clear-cache
|
||||
"run" local-rule
|
||||
"rules" list-rules
|
||||
|
||||
@@ -33,20 +33,6 @@ mkdir build\core
|
||||
mkdir build\mainclient
|
||||
mkdir build\boot
|
||||
|
||||
@rem Build the xxd tool for generating sources
|
||||
cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
link /nologo /out:build\xxd.exe build\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Generate the embedded sources
|
||||
build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the generated sources
|
||||
%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@@ -58,48 +44,25 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot build\core_image.c
|
||||
|
||||
@rem Build the core image
|
||||
%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot . > build\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the resources
|
||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
|
||||
@rem Build the main client
|
||||
for %%f in (src\mainclient\*.c) do (
|
||||
%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.a)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
for %%f in (src\core\*.c) do (
|
||||
set "amalg_files=!amalg_files! %%f"
|
||||
)
|
||||
janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
|
||||
@rem Gen shell.c
|
||||
janet.exe tools\amalg.janet src\mainclient\line.h src\mainclient\line.c src\mainclient\main.c > build\shell.c
|
||||
janet.exe tools\removecr.janet build\shell.c
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||
@@ -141,7 +104,7 @@ janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy build\shell.c dist\shell.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
@@ -157,7 +120,12 @@ copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
|
||||
janet.exe -e "(print (= (os/arch) :x64))" > build\64bit.txt
|
||||
set /p JANET_VERSION= < build\version.txt
|
||||
set /p SIXTYFOUR= < build\64bit.txt
|
||||
echo "JANET_VERSION is %JANET_VERSION%"
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" /DVERSION=%JANET_VERSION% /DSIXTYFOUR=%SIXTYFOUR% janet-installer.nsi
|
||||
exit /b 0
|
||||
|
||||
@rem Run the installer. (Installs to the local user with default settings)
|
||||
|
||||
@@ -69,14 +69,14 @@
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]")
|
||||
(when-let [constants (dasm 'constants)]
|
||||
(printf " constants: %.4Q\n" constants))
|
||||
(printf " slots: %.4Q\n\n" (frame :slots))
|
||||
(printf " constants: %.4Q" constants))
|
||||
(printf " slots: %.4Q\n" (frame :slots))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
(prin (if (= (tuple/type instr) :brackets) "*" " "))
|
||||
(prin (if (= i pc) "> " " "))
|
||||
(printf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding))
|
||||
(prinf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding))
|
||||
(when sourcemap
|
||||
(let [[sl sc] (sourcemap i)
|
||||
loc [sl sc]]
|
||||
|
||||
@@ -10,8 +10,7 @@
|
||||
|
||||
(defn make-worker
|
||||
[name interval]
|
||||
(-> (thread/new)
|
||||
(:send worker-main)
|
||||
(-> (thread/new worker-main)
|
||||
(:send name)
|
||||
(:send interval)))
|
||||
|
||||
@@ -39,8 +38,7 @@
|
||||
(if (< depth 5)
|
||||
(do
|
||||
(defn subtree []
|
||||
(-> (thread/new)
|
||||
(:send worker-tree)
|
||||
(-> (thread/new worker-tree)
|
||||
(:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu")))
|
||||
(:send (inc depth))))
|
||||
(let [l (subtree)
|
||||
@@ -51,7 +49,7 @@
|
||||
(do
|
||||
(:send parent [name]))))
|
||||
|
||||
(-> (thread/new) (:send worker-tree) (:send "adam") (:send 0))
|
||||
(-> (thread/new worker-tree) (:send "adam") (:send 0))
|
||||
(def lines (thread/receive))
|
||||
(map print lines)
|
||||
|
||||
|
||||
@@ -1,5 +1,9 @@
|
||||
Unicode True
|
||||
|
||||
!echo "Program Files: ${PROGRAMFILES}"
|
||||
!addplugindir "tools\"
|
||||
|
||||
# Version
|
||||
!define VERSION "1.6.0"
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
@@ -14,13 +18,13 @@ VIFileVersion "${PRODUCT_VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
# For now, use 32 bit folder as build is 32 bit
|
||||
# !define MULTIUSER_USE_PROGRAMFILES64
|
||||
!if ${SIXTYFOUR} == "true"
|
||||
!define MULTIUSER_USE_PROGRAMFILES64
|
||||
!endif
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
!include "MUI2.nsh"
|
||||
!include ".\tools\EnvVarUpdate.nsh"
|
||||
!include "LogicLib.nsh"
|
||||
|
||||
# Basics
|
||||
@@ -124,6 +128,15 @@ section "Janet" BfWSection
|
||||
# Start Menu
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
|
||||
# Update path
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
EnVar::SetHKCU
|
||||
${EndIf}
|
||||
EnVar::AddValue "PATH" "$INSTDIR\bin"
|
||||
Pop $0
|
||||
|
||||
# Set up Environment variables
|
||||
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
||||
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
||||
@@ -132,13 +145,6 @@ section "Janet" BfWSection
|
||||
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Update path
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||
${Else}
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||
${EndIf}
|
||||
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||
@@ -185,10 +191,12 @@ section "uninstall"
|
||||
|
||||
# Unset PATH
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||
EnVar::SetHKCU
|
||||
${EndIf}
|
||||
EnVar::DeleteValue "PATH" "$INSTDIR\bin"
|
||||
Pop $0
|
||||
|
||||
# make sure windows knows about the change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
104
janet.1
104
janet.1
@@ -9,8 +9,8 @@ janet \- run the Janet language abstract machine
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||
[\fB\-\-\fR]
|
||||
.IR script
|
||||
.IR args ...
|
||||
.BR script
|
||||
.BR args ...
|
||||
.SH DESCRIPTION
|
||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||
@@ -25,6 +25,106 @@ Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
||||
The few features that are not standard C99 (dynamic library loading, compiler
|
||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||
most new platforms.
|
||||
|
||||
.SH REPL KEY-BINDINGS
|
||||
|
||||
.TP 16
|
||||
.BR Home
|
||||
Move cursor to the beginning of input line.
|
||||
|
||||
.TP 16
|
||||
.BR End
|
||||
Move cursor to the end of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Left/Right
|
||||
Move cursor in input line.
|
||||
|
||||
.TP 16
|
||||
.BR Up/Down
|
||||
Go backwards and forwards through history.
|
||||
|
||||
.TP 16
|
||||
.BR Tab
|
||||
Complete current symbol, or show available completions.
|
||||
|
||||
.TP 16
|
||||
.BR Delete
|
||||
Delete one character after the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Backspace
|
||||
Delete one character before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-A
|
||||
Move cursor to the beginning of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-B
|
||||
Move cursor one character to the left.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-E
|
||||
Move cursor to the end of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-F
|
||||
Move cursor one character to the right.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-H
|
||||
Delete one character before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-K
|
||||
Delete everything after the cursor on the input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-L
|
||||
Clear the screen.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-N/Ctrl\-P
|
||||
Go forwards and backwards through history.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-U
|
||||
Delete everything before the cursor on the input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-W
|
||||
Delete one word before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-D
|
||||
Delete one word after the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-,
|
||||
Go to earliest item in history.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-.
|
||||
Go to last item in history.
|
||||
|
||||
.LP
|
||||
|
||||
The repl keybindings are loosely based on a subset of GNU readline, although
|
||||
Janet does not use GNU readline internally for the repl. It is a limited
|
||||
substitute for GNU readline, and does not handle
|
||||
utf-8 input or other mutlibyte input well.
|
||||
|
||||
To disable the built-in repl input handling, pass the \fB\-s\fR option to Janet, and
|
||||
use a program like rlwrap with Janet to provide input.
|
||||
|
||||
For key bindings that operate on words, a word is considered to be a sequence
|
||||
of characters that does not contain whitespace.
|
||||
|
||||
.SH DOCUMENTATION
|
||||
|
||||
For more complete API documentation, run a REPL (Read Eval Print Loop), and use the doc macro to
|
||||
|
||||
15
jpm.1
15
jpm.1
@@ -36,7 +36,7 @@ If passed to jpm install, runs tests before installing. Will run tests recursive
|
||||
|
||||
.TP
|
||||
.BR \-\-modpath=/some/path
|
||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order.
|
||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order. You most likely don't need this.
|
||||
|
||||
.TP
|
||||
.BR \-\-headerpath=/some/path
|
||||
@@ -139,6 +139,10 @@ like make. run will run a single rule or build a single file.
|
||||
.BR rules
|
||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||
|
||||
.TP
|
||||
.BR show-paths
|
||||
Show all of the paths used when installing and building artifacts.
|
||||
|
||||
.TP
|
||||
.BR update-pkgs
|
||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||
@@ -172,7 +176,8 @@ This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
|
||||
to build native modules and standalone executables. If janet.h and janetconf.h are available as
|
||||
default includes on your system, this value is not required. If not provided, will default to
|
||||
(dyn :syspath)/../../include/janet. The --headerpath=/some/path will override this variable.
|
||||
<jpm script location>/../include/janet. The --headerpath=/some/path option will override this
|
||||
variable.
|
||||
.RE
|
||||
|
||||
.B JANET_LIBPATH
|
||||
@@ -180,15 +185,15 @@ default includes on your system, this value is not required. If not provided, wi
|
||||
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
||||
libjanet.a for creating standalong executables. This does not need to be
|
||||
set on a normal install.
|
||||
If not provided, this will default to (dyn :syspath)/../../lib.
|
||||
The --libpath=/some/path will override this variable.
|
||||
If not provided, this will default to <jpm script location>/../lib.
|
||||
The --libpath=/some/path option will override this variable.
|
||||
.RE
|
||||
|
||||
.B JANET_BINPATH
|
||||
.RS
|
||||
The directory where jpm will install binary scripts and executables to.
|
||||
Defaults to
|
||||
(dyn :syspath)/../../lib.
|
||||
(dyn :syspath)/bin
|
||||
The --binpath=/some/path will override this variable.
|
||||
.RE
|
||||
|
||||
|
||||
59
meson.build
59
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose and contributors
|
||||
# Copyright (c) 2020 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.6.0-dev')
|
||||
version : '1.6.1-dev')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -62,6 +62,7 @@ conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
conf.set('JANET_NO_PRF', not get_option('prf'))
|
||||
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||
@@ -78,16 +79,10 @@ jconf = configure_file(output : 'janetconf.h',
|
||||
# Include directories
|
||||
incdir = include_directories(['src/include', '.'])
|
||||
|
||||
# Building generated sources
|
||||
xxd = executable('xxd', 'tools/xxd.c', native : true)
|
||||
gen = generator(xxd,
|
||||
output : '@BASENAME@.gen.c',
|
||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||
boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot')
|
||||
|
||||
# Order is important here, as some headers
|
||||
# depend on other headers for the amalg target
|
||||
core_headers = [
|
||||
'src/core/features.h',
|
||||
'src/core/util.h',
|
||||
'src/core/state.h',
|
||||
'src/core/gc.h',
|
||||
@@ -149,24 +144,27 @@ boot_src = [
|
||||
]
|
||||
|
||||
mainclient_src = [
|
||||
'src/mainclient/line.c',
|
||||
'src/mainclient/main.c'
|
||||
'src/mainclient/shell.c'
|
||||
]
|
||||
|
||||
# Build boot binary
|
||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
native : true)
|
||||
|
||||
# Build core image
|
||||
core_image = custom_target('core_image',
|
||||
# Build janet.c
|
||||
janetc = custom_target('janetc',
|
||||
input : [janet_boot],
|
||||
output : 'core_image.gen.c',
|
||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||
output : 'janet.c',
|
||||
capture : true,
|
||||
command : [
|
||||
janet_boot, '@CURRENT_SOURCE_DIR@',
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
])
|
||||
|
||||
libjanet = library('janet', core_src, core_image,
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
install : true)
|
||||
@@ -186,14 +184,14 @@ else
|
||||
extra_cross_cflags = []
|
||||
endif
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_native_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
@@ -209,25 +207,6 @@ docs = custom_target('docs',
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated source
|
||||
amalg = custom_target('amalg',
|
||||
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||
output : ['janet.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
amalg_shell = custom_target('amalg-shell',
|
||||
input : ['tools/amalg.janet', 'src/mainclient/line.h',
|
||||
'src/mainclient/line.c', 'src/mainclient/main.c'],
|
||||
output : ['shell.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
build_by_default : false)
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0.janet',
|
||||
@@ -257,5 +236,5 @@ install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_binscripts, install_dir : 'bin')
|
||||
install_data(sources : ['tools/.keep'], install_dir : 'lib/janet')
|
||||
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
|
||||
@@ -10,6 +10,7 @@ option('assembler', type : 'boolean', value : true)
|
||||
option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : true)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,6 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include "tests.h"
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <direct.h>
|
||||
#define chdir(x) _chdir(x)
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
extern const unsigned char *janet_gen_boot;
|
||||
extern int32_t janet_gen_boot_size;
|
||||
|
||||
@@ -63,13 +70,41 @@ int main(int argc, const char **argv) {
|
||||
janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
const char *boot_file;
|
||||
const char *boot_filename;
|
||||
#ifdef JANET_NO_SOURCEMAPS
|
||||
boot_file = NULL;
|
||||
boot_filename = NULL;
|
||||
#else
|
||||
boot_file = "boot.janet";
|
||||
boot_filename = "boot.janet";
|
||||
#endif
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
|
||||
|
||||
int chdir_status = chdir(argv[1]);
|
||||
if (chdir_status) {
|
||||
fprintf(stderr, "Could not change to directory %s\n", argv[1]);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
FILE *boot_file = fopen("src/boot/boot.janet", "rb");
|
||||
if (NULL == boot_file) {
|
||||
fprintf(stderr, "Could not open src/boot/boot.janet\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
/* Slurp file into buffer */
|
||||
fseek(boot_file, 0, SEEK_END);
|
||||
size_t boot_size = ftell(boot_file);
|
||||
fseek(boot_file, 0, SEEK_SET);
|
||||
unsigned char *boot_buffer = malloc(boot_size);
|
||||
if (NULL == boot_buffer) {
|
||||
fprintf(stderr, "Failed to allocate boot buffer\n");
|
||||
exit(1);
|
||||
}
|
||||
if (!fread(boot_buffer, 1, boot_size, boot_file)) {
|
||||
fprintf(stderr, "Failed to read into boot buffer\n");
|
||||
exit(1);
|
||||
}
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, boot_size, boot_filename, NULL);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2019 © Calvin Rose
|
||||
# Copyright 2020 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -58,6 +58,11 @@
|
||||
[name & more]
|
||||
~(def ,name :private ,;more))
|
||||
|
||||
(defmacro var-
|
||||
"Define a private var that will not be exported."
|
||||
[name & more]
|
||||
~(var ,name :private ,;more))
|
||||
|
||||
(defn defglobal
|
||||
"Dynamically create a global def."
|
||||
[name value]
|
||||
@@ -74,12 +79,12 @@
|
||||
|
||||
# Basic predicates
|
||||
(defn nan? "Check if x is NaN" [x] (not= x x))
|
||||
(defn even? "Check if x is even." [x] (== 0 (% x 2)))
|
||||
(defn even? "Check if x is even." [x] (= 0 (% x 2)))
|
||||
(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
|
||||
(defn zero? "Check if x is zero." [x] (== x 0))
|
||||
(defn zero? "Check if x is zero." [x] (= x 0))
|
||||
(defn pos? "Check if x is greater than 0." [x] (> x 0))
|
||||
(defn neg? "Check if x is less than 0." [x] (< x 0))
|
||||
(defn one? "Check if x is equal to 1." [x] (== x 1))
|
||||
(defn one? "Check if x is equal to 1." [x] (= x 1))
|
||||
(defn number? "Check if x is a number." [x] (= (type x) :number))
|
||||
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
|
||||
(defn string? "Check if x is a string." [x] (= (type x) :string))
|
||||
@@ -131,6 +136,11 @@
|
||||
(defmacro /= "Shorthand for (set x (/ x n))." [x n] ~(set ,x (,/ ,x ,n)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
|
||||
|
||||
(defn assert
|
||||
"Throw an error if x is not truthy."
|
||||
[x &opt err]
|
||||
(if x x (error (if err err "assert failure"))))
|
||||
|
||||
(defmacro default
|
||||
"Define a default value for an optional argument.
|
||||
Expands to (def sym (if (= nil sym) val sym))"
|
||||
@@ -219,7 +229,7 @@
|
||||
r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
||||
,r (,resume ,f)]
|
||||
(if (= (,fiber/status ,f) :error)
|
||||
(if (,= (,fiber/status ,f) :error)
|
||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||
,r))))
|
||||
|
||||
@@ -276,20 +286,43 @@
|
||||
(++ i))
|
||||
~(let (,;accum) ,;body))
|
||||
|
||||
(defmacro defer
|
||||
"Run form unconditionally after form, even if the body throws an error."
|
||||
[form & body]
|
||||
(with-syms [f r]
|
||||
~(do
|
||||
(def ,f (,fiber/new (fn [] ,;body) :ie))
|
||||
(def ,r (,resume ,f))
|
||||
,form
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
,r
|
||||
(propagate ,r ,f)))))
|
||||
|
||||
(defmacro with
|
||||
"Evaluate body with some resource, which will be automatically cleaned up
|
||||
if there is an error in body. binding is bound to the expression ctor, and
|
||||
dtor is a function or callable that is passed the binding. If no destructor
|
||||
(dtor) is given, will call :close on the resource."
|
||||
[[binding ctor dtor] & body]
|
||||
(with-syms [res f]
|
||||
~(let [,binding ,ctor
|
||||
,f (,fiber/new (fn [] ,;body) :ie)
|
||||
,res (,resume ,f)]
|
||||
(,(or dtor :close) ,binding)
|
||||
(if (,= (,fiber/status ,f) :error)
|
||||
(,propagate ,res ,f)
|
||||
,res))))
|
||||
~(do
|
||||
(def ,binding ,ctor)
|
||||
,(apply defer [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro when-with
|
||||
"Similar to with, but if binding is false or nil, returns
|
||||
nil without evaluating the body. Otherwise, the same as with."
|
||||
[[binding ctor dtor] & body]
|
||||
~(if-let [,binding ,ctor]
|
||||
,(apply defer [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro if-with
|
||||
"Similar to with, but if binding is false or nil, evaluates
|
||||
the falsey path. Otherwise, evaluates the truthy path. In both cases,
|
||||
ctor is bound to binding."
|
||||
[[binding ctor dtor] truthy &opt falsey ]
|
||||
~(if-let [,binding ,ctor]
|
||||
,(apply defer [(or dtor :close) binding] [truthy])
|
||||
,falsey))
|
||||
|
||||
(defn- for-template
|
||||
[binding start stop step comparison delta body]
|
||||
@@ -303,17 +336,16 @@
|
||||
(set ,i (,delta ,i ,step))))))
|
||||
|
||||
(defn- each-template
|
||||
[binding in body]
|
||||
(with-syms [i len]
|
||||
(def ds (if (idempotent? in) in (gensym)))
|
||||
[binding inx body]
|
||||
(with-syms [k]
|
||||
(def ds (if (idempotent? inx) inx (gensym)))
|
||||
~(do
|
||||
(var ,i 0)
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(def ,len (,length ,ds))
|
||||
(while (,< ,i ,len)
|
||||
(def ,binding (in ,ds ,i))
|
||||
,(unless (= ds inx) ~(def ,ds ,inx))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while (,not= nil ,k)
|
||||
(def ,binding (,in ,ds ,k))
|
||||
,;body
|
||||
(++ ,i)))))
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
|
||||
(defn- keys-template
|
||||
[binding in pair? body]
|
||||
@@ -322,7 +354,7 @@
|
||||
~(do
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while ,k
|
||||
(while (,not= nil ,k)
|
||||
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
|
||||
,;body
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
@@ -391,10 +423,20 @@
|
||||
[i start stop & body]
|
||||
(for-template i start stop 1 < + body))
|
||||
|
||||
(defmacro eachk
|
||||
"loop over each key in ds. returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds false body))
|
||||
|
||||
(defmacro eachp
|
||||
"Loop over each (key, value) pair in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds true body))
|
||||
|
||||
(defmacro each
|
||||
"Loop over each value in ind. Returns nil."
|
||||
[x ind & body]
|
||||
(each-template x ind body))
|
||||
"Loop over each value in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(each-template x ds body))
|
||||
|
||||
(defmacro loop
|
||||
"A general purpose loop macro. This macro is similar to the Common Lisp
|
||||
@@ -551,16 +593,6 @@
|
||||
"Returns the numeric minimum of the arguments."
|
||||
[& args] (extreme < args))
|
||||
|
||||
(defn max-order
|
||||
"Returns the maximum of the arguments according to a total
|
||||
order over all values."
|
||||
[& args] (extreme order> args))
|
||||
|
||||
(defn min-order
|
||||
"Returns the minimum of the arguments according to a total
|
||||
order over all values."
|
||||
[& args] (extreme order< args))
|
||||
|
||||
(defn first
|
||||
"Get the first element from an indexed data structure."
|
||||
[xs]
|
||||
@@ -605,11 +637,11 @@
|
||||
a)
|
||||
|
||||
(fn sort [a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by order<)))))
|
||||
(sort-help a 0 (- (length a) 1) (or by <)))))
|
||||
|
||||
(defn sorted
|
||||
"Returns a new sorted array without modifying the old one."
|
||||
[ind by]
|
||||
[ind &opt by]
|
||||
(sort (array/slice ind) by))
|
||||
|
||||
(defn reduce
|
||||
@@ -729,8 +761,10 @@
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(def len (length ind))
|
||||
# make sure end is in [0, len]
|
||||
(def end (max 0 (min n (length ind))))
|
||||
(def m (if (> n 0) n 0))
|
||||
(def end (if (> m len) len m))
|
||||
(f ind 0 end))
|
||||
|
||||
(defn take-until
|
||||
@@ -754,8 +788,10 @@
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(def len (length ind))
|
||||
# make sure start is in [0, len]
|
||||
(def start (max 0 (min n (length ind))))
|
||||
(def m (if (> n 0) n 0))
|
||||
(def start (if (> m len) len m))
|
||||
(f ind start -1))
|
||||
|
||||
(defn drop-until
|
||||
@@ -1427,7 +1463,7 @@
|
||||
(if-let [[path line col] sm]
|
||||
(string " " path " on line " line ", column " col "\n") "")
|
||||
(if (or d sm) "\n" "")
|
||||
(if d (doc-format d) "no documentation found.")
|
||||
(if d (doc-format d) " no documentation found.")
|
||||
"\n\n"))))
|
||||
|
||||
# else
|
||||
@@ -1520,7 +1556,8 @@
|
||||
'quote identity
|
||||
'quasiquote expandqq
|
||||
'var expanddef
|
||||
'while expandall})
|
||||
'while expandall
|
||||
'break expandall})
|
||||
|
||||
(defn dotup [t]
|
||||
(def h (in t 0))
|
||||
@@ -1552,7 +1589,7 @@
|
||||
ret)
|
||||
|
||||
(defn some
|
||||
"Returns false if all xs are false or nil, otherwise returns the first true value."
|
||||
"Returns nil if all xs are false or nil, otherwise returns the first true value."
|
||||
[pred xs]
|
||||
(var ret nil)
|
||||
(loop [x :in xs :while (not ret)] (if-let [y (pred x)] (set ret y)))
|
||||
@@ -1677,6 +1714,32 @@
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
|
||||
###
|
||||
###
|
||||
### Default PEG patterns
|
||||
###
|
||||
###
|
||||
|
||||
(def default-peg-grammar
|
||||
"The default grammar used for pegs. This grammar defines several common patterns
|
||||
that should make it easier to write more complex patterns."
|
||||
~@{:d (range "09")
|
||||
:a (range "az" "AZ")
|
||||
:s (set " \t\r\n\0\f")
|
||||
:w (range "az" "AZ" "09")
|
||||
:S (if-not :s 1)
|
||||
:W (if-not :w 1)
|
||||
:A (if-not :a 1)
|
||||
:D (if-not :d 1)
|
||||
:d+ (some :d)
|
||||
:a+ (some :a)
|
||||
:s+ (some :s)
|
||||
:w+ (some :w)
|
||||
:d* (any :d)
|
||||
:a* (any :a)
|
||||
:w* (any :w)
|
||||
:s* (any :s)})
|
||||
|
||||
###
|
||||
###
|
||||
### Evaluation and Compilation
|
||||
@@ -1718,14 +1781,15 @@
|
||||
"Default handler for a compile error."
|
||||
[msg macrof where]
|
||||
(def ec (dyn :err-color))
|
||||
(eprint
|
||||
(if ec "\e[31m" "")
|
||||
"compile error: "
|
||||
msg
|
||||
" while compiling "
|
||||
where
|
||||
(if ec "\e[0m" ""))
|
||||
(when macrof (debug/stacktrace macrof)))
|
||||
(if macrof
|
||||
(debug/stacktrace macrof (string msg " while compiling " where))
|
||||
(eprint
|
||||
(if ec "\e[31m" "")
|
||||
"compile error: "
|
||||
msg
|
||||
" while compiling "
|
||||
where
|
||||
(if ec "\e[0m" ""))))
|
||||
|
||||
(defn run-context
|
||||
"Run a context. This evaluates expressions of janet in an environment,
|
||||
@@ -1752,7 +1816,7 @@
|
||||
:source where
|
||||
:expander expand} opts)
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(default chunks (fn [buf p] (getline "" buf)))
|
||||
(default chunks (fn [buf p] (getline "" buf env)))
|
||||
(default onstatus debug/stacktrace)
|
||||
(default on-compile-error bad-compile)
|
||||
(default on-parse-error bad-parse)
|
||||
@@ -1898,27 +1962,33 @@
|
||||
from searching that path template if the filter doesn't match the input
|
||||
path. The filter can be a string or a predicate function, and
|
||||
is often a file extension, including the period."
|
||||
@[# Relative to (dyn :current-file "./."). Path must start with .
|
||||
[":cur:/:all:.jimage" :image check-.]
|
||||
[":cur:/:all:.janet" :source check-.]
|
||||
[":cur:/:all:/init.janet" :source check-.]
|
||||
[":cur:/:all::native:" :native check-.]
|
||||
|
||||
# As a path from (os/cwd)
|
||||
[":all:.jimage" :image not-check-.]
|
||||
[":all:.janet" :source not-check-.]
|
||||
[":all:/init.janet" :source not-check-.]
|
||||
[":all::native:" :native not-check-.]
|
||||
|
||||
# System paths
|
||||
[":sys:/:all:.jimage" :image not-check-.]
|
||||
[":sys:/:all:.janet" :source not-check-.]
|
||||
[":sys:/:all:/init.janet" :source not-check-.]
|
||||
[":sys:/:all::native:" :native not-check-.]])
|
||||
@[])
|
||||
|
||||
(setdyn :syspath (boot/opts "JANET_PATH"))
|
||||
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
|
||||
|
||||
(defn module/add-paths
|
||||
"Add paths to module/paths for a given loader such that
|
||||
the generated paths behave like other module types, including
|
||||
relative imports and syspath imports. ext is the file extension
|
||||
to associate with this module type, including the dot. loader is the
|
||||
keyword name of a loader that is module/loaders. Returns the modified module/paths."
|
||||
[ext loader]
|
||||
(defn- find-prefix
|
||||
[pre]
|
||||
(or (find-index |(string/has-prefix? pre ($ 0)) module/paths) 0))
|
||||
(array/insert module/paths 0 [(string ":cur:/:all:" ext) loader check-.])
|
||||
(def all-index (find-prefix ":all:"))
|
||||
(array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
|
||||
(def sys-index (find-prefix ":sys:"))
|
||||
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.])
|
||||
module/paths)
|
||||
|
||||
(module/add-paths ":native:" :native)
|
||||
(module/add-paths "/init.janet" :source)
|
||||
(module/add-paths ".janet" :source)
|
||||
(module/add-paths ".jimage" :image)
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(if-let [has-stat (_env 'os/stat)]
|
||||
(let [stat (has-stat :value)]
|
||||
@@ -2045,7 +2115,7 @@
|
||||
(if-let [check (in module/cache fullpath)]
|
||||
check
|
||||
(do
|
||||
(def loader (module/loaders mod-kind))
|
||||
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
|
||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||
(def env (loader fullpath args))
|
||||
(put module/cache fullpath env)
|
||||
@@ -2060,7 +2130,10 @@
|
||||
:prefix prefix
|
||||
:export ep} (table ;args))
|
||||
(def newenv (require path ;args))
|
||||
(def prefix (or (and as (string as "/")) prefix (string path "/")))
|
||||
(def prefix (or
|
||||
(and as (string as "/"))
|
||||
prefix
|
||||
(string (last (string/split "/" path)) "/")))
|
||||
(loop [[k v] :pairs newenv :when (symbol? k) :when (not (v :private))]
|
||||
(def newv (table/setproto @{:private (not ep)} v))
|
||||
(put env (symbol prefix k) newv)))
|
||||
@@ -2072,7 +2145,7 @@
|
||||
use the name of the module as a prefix. One can also use :export true
|
||||
to re-export the imported symbols. If :exit true is given as an argument,
|
||||
any errors encountered at the top level in the module will cause (os/exit 1)
|
||||
to be called."
|
||||
to be called. Dynamic bindings will NOT be imported."
|
||||
[path & args]
|
||||
(def argm (map (fn [x]
|
||||
(if (keyword? x)
|
||||
@@ -2105,7 +2178,7 @@
|
||||
((parser/where p) 0)
|
||||
":"
|
||||
(parser/state p :delimiters) "> ")
|
||||
buf)))
|
||||
buf env)))
|
||||
(defn make-onsignal
|
||||
[e level]
|
||||
|
||||
@@ -2120,7 +2193,7 @@
|
||||
(def status (parser/state p :delimiters))
|
||||
(def c ((parser/where p) 0))
|
||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prompt buf))
|
||||
(getline prompt buf nextenv))
|
||||
(print "entering debug[" level "] - (quit) to exit")
|
||||
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
||||
(print "exiting debug[" level "]")
|
||||
@@ -2246,23 +2319,24 @@
|
||||
|
||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||
(if-not *quiet*
|
||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
|
||||
(defn noprompt [_] "")
|
||||
(defn getprompt [p]
|
||||
(def [line] (parser/where p))
|
||||
(string "janet:" line ":" (parser/state p :delimiters) "> "))
|
||||
(def prompter (if *quiet* noprompt getprompt))
|
||||
(defn getstdin [prompt buf]
|
||||
(defn getstdin [prompt buf _]
|
||||
(file/write stdout prompt)
|
||||
(file/flush stdout)
|
||||
(file/read stdin :line buf))
|
||||
(def env (make-env))
|
||||
(def getter (if *raw-stdin* getstdin getline))
|
||||
(defn getchunk [buf p]
|
||||
(getter (prompter p) buf))
|
||||
(getter (prompter p) buf env))
|
||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(repl getchunk onsig)))
|
||||
(repl getchunk onsig env)))
|
||||
|
||||
|
||||
###
|
||||
@@ -2317,21 +2391,88 @@
|
||||
reverse-lookup (invert lookup)]
|
||||
(marshal env reverse-lookup)))
|
||||
|
||||
# Create amalgamation
|
||||
|
||||
(def local-headers
|
||||
["src/core/features.h"
|
||||
"src/core/util.h"
|
||||
"src/core/state.h"
|
||||
"src/core/gc.h"
|
||||
"src/core/vector.h"
|
||||
"src/core/fiber.h"
|
||||
"src/core/regalloc.h"
|
||||
"src/core/compile.h"
|
||||
"src/core/emit.h"
|
||||
"src/core/symcache.h"])
|
||||
|
||||
(def core-sources
|
||||
["src/core/abstract.c"
|
||||
"src/core/array.c"
|
||||
"src/core/asm.c"
|
||||
"src/core/buffer.c"
|
||||
"src/core/bytecode.c"
|
||||
"src/core/capi.c"
|
||||
"src/core/cfuns.c"
|
||||
"src/core/compile.c"
|
||||
"src/core/corelib.c"
|
||||
"src/core/debug.c"
|
||||
"src/core/emit.c"
|
||||
"src/core/fiber.c"
|
||||
"src/core/gc.c"
|
||||
"src/core/inttypes.c"
|
||||
"src/core/io.c"
|
||||
"src/core/marsh.c"
|
||||
"src/core/math.c"
|
||||
"src/core/os.c"
|
||||
"src/core/parse.c"
|
||||
"src/core/peg.c"
|
||||
"src/core/pp.c"
|
||||
"src/core/regalloc.c"
|
||||
"src/core/run.c"
|
||||
"src/core/specials.c"
|
||||
"src/core/string.c"
|
||||
"src/core/strtod.c"
|
||||
"src/core/struct.c"
|
||||
"src/core/symcache.c"
|
||||
"src/core/table.c"
|
||||
"src/core/thread.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/typedarray.c"
|
||||
"src/core/util.c"
|
||||
"src/core/value.c"
|
||||
"src/core/vector.c"
|
||||
"src/core/vm.c"
|
||||
"src/core/wrap.c"])
|
||||
|
||||
# Print janet.c to stdout
|
||||
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||
(print "/* Generated from janet version " janet/version "-" janet/build " */")
|
||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||
(print ```#define JANET_AMALG```)
|
||||
(print ```#define _POSIX_C_SOURCE 200112L```)
|
||||
(print ```#include "janet.h"```)
|
||||
|
||||
(defn do-one-flie
|
||||
[fname]
|
||||
(print "\n/* " fname " */\n")
|
||||
(def source (slurp fname))
|
||||
(print (string/replace-all "\r" "" source)))
|
||||
|
||||
(each h local-headers
|
||||
(do-one-flie h))
|
||||
|
||||
(each s core-sources
|
||||
(do-one-flie s))
|
||||
|
||||
# Create C source file that contains images a uint8_t buffer. This
|
||||
# can be compiled and linked statically into the main janet library
|
||||
# and example client.
|
||||
(def chunks (string/bytes image))
|
||||
(def image-file (file/open (boot/args 1) :wb))
|
||||
(file/write image-file
|
||||
"#ifndef JANET_AMALG\n"
|
||||
"#include <janet.h>\n"
|
||||
"#endif\n"
|
||||
"static const unsigned char janet_core_image_bytes[] = {\n")
|
||||
(loop [line :in (partition 10 chunks)]
|
||||
(def str (string ;(interpose ", " (map (partial string/format "0x%.2X") line))))
|
||||
(file/write image-file " " str ",\n"))
|
||||
(file/write image-file
|
||||
" 0\n};\n\n"
|
||||
"const unsigned char *janet_core_image = janet_core_image_bytes;\n"
|
||||
"size_t janet_core_image_size = sizeof(janet_core_image_bytes);\n")
|
||||
(file/close image-file))
|
||||
(print "static const unsigned char janet_core_image_bytes[] = {")
|
||||
(loop [line :in (partition 16 image)]
|
||||
(prin " ")
|
||||
(each b line
|
||||
(prinf "0x%.2X, " b))
|
||||
(print))
|
||||
(print " 0\n};\n")
|
||||
(print "const unsigned char *janet_core_image = janet_core_image_bytes;")
|
||||
(print "size_t janet_core_image_size = sizeof(janet_core_image_bytes);"))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -28,9 +28,9 @@
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 6
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.6.0-dev"
|
||||
#define JANET_VERSION "1.6.1-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -51,6 +51,7 @@
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_PRF */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
@@ -35,7 +36,7 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
||||
data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -51,11 +52,11 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
array->capacity = n;
|
||||
array->count = n;
|
||||
array->data = malloc(sizeof(Janet) * n);
|
||||
array->data = malloc(sizeof(Janet) * (size_t) n);
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(array->data, elements, sizeof(Janet) * n);
|
||||
safe_memcpy(array->data, elements, sizeof(Janet) * n);
|
||||
return array;
|
||||
}
|
||||
|
||||
@@ -92,6 +93,9 @@ void janet_array_setcount(JanetArray *array, int32_t count) {
|
||||
|
||||
/* Push a value to the top of the array */
|
||||
void janet_array_push(JanetArray *array, Janet x) {
|
||||
if (array->count == INT32_MAX) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
int32_t newcount = array->count + 1;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
array->data[array->count] = x;
|
||||
@@ -125,6 +129,28 @@ static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
JanetArray *array = janet_array(count);
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
array->data[i] = x;
|
||||
}
|
||||
array->count = count;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_fill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
for (int32_t i = 0; i < array->count; i++) {
|
||||
array->data[i] = x;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
@@ -140,9 +166,12 @@ static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (INT32_MAX - argc + 1 <= array->count) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
int32_t newcount = array->count - 1 + argc;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
if (argc > 1) memcpy(array->data + array->count, argv + 1, (argc - 1) * sizeof(Janet));
|
||||
if (argc > 1) memcpy(array->data + array->count, argv + 1, (size_t)(argc - 1) * sizeof(Janet));
|
||||
array->count = newcount;
|
||||
return argv[0];
|
||||
}
|
||||
@@ -202,11 +231,16 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
|
||||
chunksize = (argc - 2) * sizeof(Janet);
|
||||
restsize = (array->count - at) * sizeof(Janet);
|
||||
if (INT32_MAX - (argc - 2) < array->count) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
memcpy(array->data + at, argv + 2, chunksize);
|
||||
if (restsize) {
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
}
|
||||
safe_memcpy(array->data + at, argv + 2, chunksize);
|
||||
array->count += (argc - 2);
|
||||
return argv[0];
|
||||
}
|
||||
@@ -243,6 +277,17 @@ static const JanetReg array_cfuns[] = {
|
||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||
},
|
||||
{
|
||||
"array/new-filled", cfun_array_new_filled,
|
||||
JDOC("(array/new-filled count &opt value)\n\n"
|
||||
"Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.")
|
||||
},
|
||||
{
|
||||
"array/fill", cfun_array_fill,
|
||||
JDOC("(array/fill arr &opt value)\n\n"
|
||||
"Replace all elements of an array with value (defaulting to nil) without changing the length of the array. "
|
||||
"Returns the modified array.")
|
||||
},
|
||||
{
|
||||
"array/pop", cfun_array_pop,
|
||||
JDOC("(array/pop arr)\n\n"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
@@ -77,17 +78,17 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||
{"eqn", JOP_NUMERIC_EQUAL},
|
||||
{"err", JOP_ERROR},
|
||||
{"get", JOP_GET},
|
||||
{"geti", JOP_GET_INDEX},
|
||||
{"gt", JOP_GREATER_THAN},
|
||||
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||
{"gte", JOP_GREATER_THAN_EQUAL},
|
||||
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
||||
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
||||
{"in", JOP_IN},
|
||||
{"jmp", JOP_JUMP},
|
||||
{"jmpif", JOP_JUMP_IF},
|
||||
{"jmpni", JOP_JUMP_IF_NIL},
|
||||
{"jmpnn", JOP_JUMP_IF_NOT_NIL},
|
||||
{"jmpno", JOP_JUMP_IF_NOT},
|
||||
{"ldc", JOP_LOAD_CONSTANT},
|
||||
{"ldf", JOP_LOAD_FALSE},
|
||||
@@ -98,9 +99,8 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"ldu", JOP_LOAD_UPVALUE},
|
||||
{"len", JOP_LENGTH},
|
||||
{"lt", JOP_LESS_THAN},
|
||||
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
|
||||
{"lte", JOP_LESS_THAN_EQUAL},
|
||||
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
||||
{"ltn", JOP_NUMERIC_LESS_THAN},
|
||||
{"mkarr", JOP_MAKE_ARRAY},
|
||||
{"mkbtp", JOP_MAKE_BRACKET_TUPLE},
|
||||
{"mkbuf", JOP_MAKE_BUFFER},
|
||||
@@ -108,10 +108,12 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"mkstu", JOP_MAKE_STRUCT},
|
||||
{"mktab", JOP_MAKE_TABLE},
|
||||
{"mktup", JOP_MAKE_TUPLE},
|
||||
{"mod", JOP_MODULO},
|
||||
{"movf", JOP_MOVE_FAR},
|
||||
{"movn", JOP_MOVE_NEAR},
|
||||
{"mul", JOP_MULTIPLY},
|
||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||
{"next", JOP_NEXT},
|
||||
{"noop", JOP_NOOP},
|
||||
{"prop", JOP_PROPAGATE},
|
||||
{"push", JOP_PUSH},
|
||||
@@ -120,6 +122,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"pusha", JOP_PUSH_ARRAY},
|
||||
{"put", JOP_PUT},
|
||||
{"puti", JOP_PUT_INDEX},
|
||||
{"rem", JOP_REMAINDER},
|
||||
{"res", JOP_RESUME},
|
||||
{"ret", JOP_RETURN},
|
||||
{"retn", JOP_RETURN_NIL},
|
||||
@@ -173,17 +176,25 @@ static void janet_asm_deinit(JanetAssembler *a) {
|
||||
janet_table_deinit(&a->defs);
|
||||
}
|
||||
|
||||
static void janet_asm_longjmp(JanetAssembler *a) {
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(a->on_error, 1);
|
||||
#else
|
||||
longjmp(a->on_error, 1);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Throw some kind of assembly error */
|
||||
static void janet_asm_error(JanetAssembler *a, const char *message) {
|
||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||
longjmp(a->on_error, 1);
|
||||
janet_asm_longjmp(a);
|
||||
}
|
||||
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
|
||||
|
||||
/* Throw some kind of assembly error */
|
||||
static void janet_asm_errorv(JanetAssembler *a, const uint8_t *m) {
|
||||
a->errmessage = m;
|
||||
longjmp(a->on_error, 1);
|
||||
janet_asm_longjmp(a);
|
||||
}
|
||||
|
||||
/* Add a closure environment to the assembler. Sub funcdefs may need
|
||||
@@ -501,10 +512,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
janet_table_init(&a.defs, 0);
|
||||
|
||||
/* Set error jump */
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
if (_setjmp(a.on_error)) {
|
||||
#else
|
||||
if (setjmp(a.on_error)) {
|
||||
#endif
|
||||
if (NULL != a.parent) {
|
||||
janet_asm_deinit(&a);
|
||||
longjmp(a.parent->on_error, 1);
|
||||
janet_asm_longjmp(a.parent);
|
||||
}
|
||||
result.funcdef = NULL;
|
||||
result.error = a.errmessage;
|
||||
@@ -570,7 +585,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_csymbolv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = malloc(sizeof(Janet) * count);
|
||||
def->constants = malloc(sizeof(Janet) * (size_t) count);
|
||||
if (NULL == def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -649,7 +664,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
/* Allocate bytecode array */
|
||||
def->bytecode_length = blength;
|
||||
def->bytecode = malloc(sizeof(uint32_t) * blength);
|
||||
def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -691,7 +706,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_csymbolv("sourcemap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
@@ -31,8 +32,8 @@
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity;
|
||||
data = malloc(sizeof(uint8_t) * capacity);
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -61,8 +62,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
if (capacity <= buffer->capacity) return;
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_vm_next_collection += capacity - buffer->capacity;
|
||||
new_data = realloc(old, capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -93,7 +94,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
if (new_size > buffer->capacity) {
|
||||
int32_t new_capacity = new_size * 2;
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_vm_next_collection += new_capacity - buffer->capacity;
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -111,6 +112,7 @@ void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
|
||||
/* Push multiple bytes into the buffer */
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
if (0 == length) return;
|
||||
janet_buffer_extra(buffer, length);
|
||||
memcpy(buffer->data + buffer->count, string, length);
|
||||
buffer->count += length;
|
||||
@@ -182,6 +184,19 @@ static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t byte = 0;
|
||||
if (argc == 2) {
|
||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||
}
|
||||
if (buffer->count) {
|
||||
memset(buffer->data, byte, buffer->count);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -324,11 +339,13 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
janet_panic("buffer blit out of range");
|
||||
janet_buffer_ensure(dest, (int32_t) last, 2);
|
||||
if (last > dest->count) dest->count = (int32_t) last;
|
||||
if (same_buf) {
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
if (length_src) {
|
||||
if (same_buf) {
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
}
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
@@ -345,8 +362,8 @@ static const JanetReg buffer_cfuns[] = {
|
||||
{
|
||||
"buffer/new", cfun_buffer_new,
|
||||
JDOC("(buffer/new capacity)\n\n"
|
||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||
"Returns a new buffer.")
|
||||
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
|
||||
"Returns a new buffer of length 0.")
|
||||
},
|
||||
{
|
||||
"buffer/new-filled", cfun_buffer_new_filled,
|
||||
@@ -354,6 +371,12 @@ static const JanetReg buffer_cfuns[] = {
|
||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||
"Returns the new buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/fill", cfun_buffer_fill,
|
||||
JDOC("(buffer/fill buffer &opt byte)\n\n"
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
"Returns the modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
@@ -40,6 +41,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_MODULO, */
|
||||
JINT_SSS, /* JOP_REMAINDER, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
JINT_SSS, /* JOP_BOR, */
|
||||
JINT_SSS, /* JOP_BXOR, */
|
||||
@@ -55,6 +58,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_L, /* JOP_JUMP, */
|
||||
JINT_SL, /* JOP_JUMP_IF, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NIL, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT_NIL, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN, */
|
||||
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_LESS_THAN, */
|
||||
@@ -93,11 +98,9 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_S, /* JOP_MAKE_TABLE */
|
||||
JINT_S, /* JOP_MAKE_TUPLE */
|
||||
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
|
||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
|
||||
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
|
||||
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN_EQUAL */
|
||||
JINT_SSS /* JOP_NUMERIC_EQUAL */
|
||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NEXT */
|
||||
};
|
||||
|
||||
/* Verify some bytecode */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,21 +21,31 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
void janet_panicv(Janet message) {
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
longjmp(*janet_vm_jmp_buf, 1);
|
||||
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(*janet_vm_jmp_buf, sig);
|
||||
#else
|
||||
longjmp(*janet_vm_jmp_buf, sig);
|
||||
#endif
|
||||
} else {
|
||||
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
||||
fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_panicv(Janet message) {
|
||||
janet_signalv(JANET_SIGNAL_ERROR, message);
|
||||
}
|
||||
|
||||
void janet_panicf(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
@@ -145,6 +155,13 @@ DEFINE_OPTLEN(buffer, BUFFER, JanetBuffer *)
|
||||
DEFINE_OPTLEN(table, TABLE, JanetTable *)
|
||||
DEFINE_OPTLEN(array, ARRAY, JanetArray *)
|
||||
|
||||
const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
||||
return dflt;
|
||||
}
|
||||
return janet_getcstring(argv, n);
|
||||
}
|
||||
|
||||
#undef DEFINE_GETTER
|
||||
#undef DEFINE_OPT
|
||||
#undef DEFINE_OPTLEN
|
||||
@@ -168,6 +185,30 @@ bad:
|
||||
janet_panicf("bad slot #%d, expected non-negative 32 bit signed integer, got %v", n, x);
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
JanetAbstract a = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(a) != at) return NULL;
|
||||
return a;
|
||||
}
|
||||
|
||||
static int janet_strlike_cmp(JanetType type, Janet x, const char *cstring) {
|
||||
if (janet_type(x) != type) return 0;
|
||||
return !janet_cstrcmp(janet_unwrap_string(x), cstring);
|
||||
}
|
||||
|
||||
int janet_keyeq(Janet x, const char *cstring) {
|
||||
return janet_strlike_cmp(JANET_KEYWORD, x, cstring);
|
||||
}
|
||||
|
||||
int janet_streq(Janet x, const char *cstring) {
|
||||
return janet_strlike_cmp(JANET_STRING, x, cstring);
|
||||
}
|
||||
|
||||
int janet_symeq(Janet x, const char *cstring) {
|
||||
return janet_strlike_cmp(JANET_SYMBOL, x, cstring);
|
||||
}
|
||||
|
||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
@@ -111,6 +112,15 @@ static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
||||
@@ -235,41 +245,23 @@ static JanetSlot compreduce(
|
||||
return t;
|
||||
}
|
||||
|
||||
static JanetSlot do_order_gt(JanetFopts opts, JanetSlot *args) {
|
||||
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, 0);
|
||||
}
|
||||
static JanetSlot do_order_lt(JanetFopts opts, JanetSlot *args) {
|
||||
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN, 0);
|
||||
}
|
||||
static JanetSlot do_order_gte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN, 1);
|
||||
}
|
||||
static JanetSlot do_order_lte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, 1);
|
||||
}
|
||||
static JanetSlot do_order_eq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, 0);
|
||||
}
|
||||
static JanetSlot do_order_neq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, 1);
|
||||
}
|
||||
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN, 0);
|
||||
}
|
||||
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NUMERIC_LESS_THAN, 0);
|
||||
}
|
||||
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
|
||||
}
|
||||
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NUMERIC_LESS_THAN_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
|
||||
}
|
||||
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NUMERIC_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_EQUALS, 0);
|
||||
}
|
||||
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NUMERIC_EQUAL, 1);
|
||||
return compreduce(opts, args, JOP_EQUALS, 1);
|
||||
}
|
||||
|
||||
/* Arranged by tag */
|
||||
@@ -293,12 +285,6 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_rshift},
|
||||
{NULL, do_rshiftu},
|
||||
{fixarity1, do_bnot},
|
||||
{NULL, do_order_gt},
|
||||
{NULL, do_order_lt},
|
||||
{NULL, do_order_gte},
|
||||
{NULL, do_order_lte},
|
||||
{NULL, do_order_eq},
|
||||
{NULL, do_order_neq},
|
||||
{NULL, do_gt},
|
||||
{NULL, do_lt},
|
||||
{NULL, do_gte},
|
||||
@@ -306,7 +292,10 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate},
|
||||
{fixarity2, do_get}
|
||||
{fixarity2, do_get},
|
||||
{fixarity2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
@@ -582,18 +583,21 @@ static int macroexpand1(
|
||||
es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity);
|
||||
c->result.macrofiber = NULL;
|
||||
janetc_error(c, es);
|
||||
return 0;
|
||||
}
|
||||
/* Set env */
|
||||
fiberp->env = c->env;
|
||||
int lock = janet_gclock();
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x);
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", x);
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
c->result.macrofiber = fiberp;
|
||||
janetc_error(c, es);
|
||||
return 0;
|
||||
} else {
|
||||
*out = x;
|
||||
*out = tempOut;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -704,20 +708,20 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
/* Copy bytecode (only last chunk) */
|
||||
def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
|
||||
if (def->bytecode_length) {
|
||||
size_t s = sizeof(int32_t) * def->bytecode_length;
|
||||
size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
|
||||
def->bytecode = malloc(s);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
safe_memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||
if (NULL != c->mapbuffer && c->source) {
|
||||
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
|
||||
size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
|
||||
def->sourcemap = malloc(s);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
|
||||
safe_memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->mapbuffer) = scope->bytecode_start;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#define JANET_COMPILE_H
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
@@ -48,20 +49,17 @@
|
||||
#define JANET_FUN_RSHIFT 17
|
||||
#define JANET_FUN_RSHIFTU 18
|
||||
#define JANET_FUN_BNOT 19
|
||||
#define JANET_FUN_ORDER_GT 20
|
||||
#define JANET_FUN_ORDER_LT 21
|
||||
#define JANET_FUN_ORDER_GTE 22
|
||||
#define JANET_FUN_ORDER_LTE 23
|
||||
#define JANET_FUN_ORDER_EQ 24
|
||||
#define JANET_FUN_ORDER_NEQ 25
|
||||
#define JANET_FUN_GT 26
|
||||
#define JANET_FUN_LT 27
|
||||
#define JANET_FUN_GTE 28
|
||||
#define JANET_FUN_LTE 29
|
||||
#define JANET_FUN_EQ 30
|
||||
#define JANET_FUN_NEQ 31
|
||||
#define JANET_FUN_PROP 32
|
||||
#define JANET_FUN_GET 33
|
||||
#define JANET_FUN_GT 20
|
||||
#define JANET_FUN_LT 21
|
||||
#define JANET_FUN_GTE 22
|
||||
#define JANET_FUN_LTE 23
|
||||
#define JANET_FUN_EQ 24
|
||||
#define JANET_FUN_NEQ 25
|
||||
#define JANET_FUN_PROP 26
|
||||
#define JANET_FUN_GET 27
|
||||
#define JANET_FUN_NEXT 28
|
||||
#define JANET_FUN_MODULO 29
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include <math.h>
|
||||
#include "compile.h"
|
||||
@@ -345,7 +346,7 @@ static Janet janet_core_tuple(int32_t argc, Janet *argv) {
|
||||
static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(argc);
|
||||
array->count = argc;
|
||||
memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
safe_memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
@@ -401,17 +402,19 @@ static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t val = janet_getinteger(argv, 0);
|
||||
if (val < 0)
|
||||
janet_panic("expected non-negative integer");
|
||||
janet_vm_gc_interval = val;
|
||||
size_t s = janet_getsize(argv, 0);
|
||||
/* limit interval to 48 bits */
|
||||
if (s > 0xFFFFFFFFFFFFUl) {
|
||||
janet_panic("interval too large");
|
||||
}
|
||||
janet_vm_gc_interval = s;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(janet_vm_gc_interval);
|
||||
return janet_wrap_number((double) janet_vm_gc_interval);
|
||||
}
|
||||
|
||||
static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
@@ -424,20 +427,6 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_next(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetDictView view = janet_getdictionary(argv, 0);
|
||||
const JanetKV *end = view.kvs + view.cap;
|
||||
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
|
||||
? view.kvs
|
||||
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
@@ -627,15 +616,6 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:cfunction\n\n"
|
||||
"or another symbol for an abstract type.")
|
||||
},
|
||||
{
|
||||
"next", janet_core_next,
|
||||
JDOC("(next dict &opt key)\n\n"
|
||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through. ")
|
||||
},
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
JDOC("(hash value)\n\n"
|
||||
@@ -645,8 +625,10 @@ static const JanetReg corelib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline &opt prompt buf)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
JDOC("(getline &opt prompt buf env)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. "
|
||||
"An optional environment table can be provided for autocomplete. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
@@ -945,6 +927,18 @@ static const uint32_t propagate_asm[] = {
|
||||
JOP_PROPAGATE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t next_asm[] = {
|
||||
JOP_NEXT | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t modulo_asm[] = {
|
||||
JOP_MODULO | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifdef JANET_BOOTSTRAP */
|
||||
|
||||
/*
|
||||
@@ -987,6 +981,22 @@ static void janet_load_libs(JanetTable *env) {
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_quick_asm(env, JANET_FUN_MODULO,
|
||||
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
|
||||
JDOC("(mod dividend divisor)\n\n"
|
||||
"Returns the modulo of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_REMAINDER,
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 2, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a datastructure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
janet_quick_asm(env, JANET_FUN_PROP,
|
||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||
JDOC("(propagate x fiber)\n\n"
|
||||
@@ -1090,46 +1100,24 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"for positive shifts the return value will always be positive."));
|
||||
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
|
||||
JDOC("(order> & xs)\n\n"
|
||||
"Check if xs is strictly descending according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
|
||||
JDOC("(order< & xs)\n\n"
|
||||
"Check if xs is strictly increasing according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
|
||||
JDOC("(order>= & xs)\n\n"
|
||||
"Check if xs is not increasing according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
|
||||
JDOC("(order<= & xs)\n\n"
|
||||
"Check if xs is not decreasing according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Returns true if all values in xs are the same, false otherwise."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Return true if any values in xs are not equal, otherwise false."));
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
|
||||
JDOC("(> & xs)\n\n"
|
||||
"Check if xs is in numerically descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
|
||||
JDOC("(< & xs)\n\n"
|
||||
"Check if xs is in numerically ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
|
||||
JDOC("(>= & xs)\n\n"
|
||||
"Check if xs is in numerically non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
|
||||
JDOC("(<= & xs)\n\n"
|
||||
"Check if xs is in numerically non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
|
||||
JDOC("(== & xs)\n\n"
|
||||
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
|
||||
JDOC("(not== & xs)\n\n"
|
||||
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
|
||||
/* Platform detection */
|
||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
@@ -274,7 +275,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
}
|
||||
/* Add stack arguments */
|
||||
slots = janet_array(def->slotcount);
|
||||
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,17 +20,13 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_LINE_H_defined
|
||||
#define JANET_LINE_H_defined
|
||||
/* Feature test macros */
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#ifndef JANET_FEATURES_H_defined
|
||||
#define JANET_FEATURES_H_defined
|
||||
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
#endif
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "fiber.h"
|
||||
#include "state.h"
|
||||
@@ -34,7 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->stackstart = JANET_FRAME_SIZE;
|
||||
fiber->stacktop = JANET_FRAME_SIZE;
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
fiber->env = NULL;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
@@ -46,7 +47,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
capacity = 32;
|
||||
}
|
||||
fiber->capacity = capacity;
|
||||
data = malloc(sizeof(Janet) * capacity);
|
||||
data = malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -64,7 +65,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
if (newstacktop >= fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||
safe_memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||
fiber->stacktop = newstacktop;
|
||||
}
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
@@ -134,7 +135,7 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||
if (newtop > fiber->capacity) {
|
||||
janet_fiber_grow(fiber, newtop);
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
fiber->stacktop = newtop;
|
||||
}
|
||||
|
||||
@@ -210,13 +211,13 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
static void janet_env_detach(JanetFuncEnv *env) {
|
||||
/* Check for closure environment */
|
||||
if (env) {
|
||||
size_t s = sizeof(Janet) * env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) env->length;
|
||||
Janet *vmem = malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(vmem, env->as.fiber->data + env->offset, s);
|
||||
safe_memcpy(vmem, env->as.fiber->data + env->offset, s);
|
||||
env->offset = 0;
|
||||
env->as.values = vmem;
|
||||
}
|
||||
@@ -368,7 +369,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
if (argc == 2) {
|
||||
int32_t i;
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
fiber->flags = 0;
|
||||
fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
for (i = 0; i < view.len; i++) {
|
||||
if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,6 +27,34 @@
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
/* Fiber signal masks. */
|
||||
#define JANET_FIBER_MASK_ERROR 2
|
||||
#define JANET_FIBER_MASK_DEBUG 4
|
||||
#define JANET_FIBER_MASK_YIELD 8
|
||||
|
||||
#define JANET_FIBER_MASK_USER0 (16 << 0)
|
||||
#define JANET_FIBER_MASK_USER1 (16 << 1)
|
||||
#define JANET_FIBER_MASK_USER2 (16 << 2)
|
||||
#define JANET_FIBER_MASK_USER3 (16 << 3)
|
||||
#define JANET_FIBER_MASK_USER4 (16 << 4)
|
||||
#define JANET_FIBER_MASK_USER5 (16 << 5)
|
||||
#define JANET_FIBER_MASK_USER6 (16 << 6)
|
||||
#define JANET_FIBER_MASK_USER7 (16 << 7)
|
||||
#define JANET_FIBER_MASK_USER8 (16 << 8)
|
||||
#define JANET_FIBER_MASK_USER9 (16 << 9)
|
||||
|
||||
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
|
||||
#define JANET_FIBER_MASK_USER 0x3FF0
|
||||
|
||||
#define JANET_FIBER_STATUS_MASK 0xFF0000
|
||||
#define JANET_FIBER_STATUS_OFFSET 16
|
||||
|
||||
#define JANET_FIBER_BREAKPOINT 0x1000000
|
||||
#define JANET_FIBER_RESUME_NO_USEVAL 0x2000000
|
||||
#define JANET_FIBER_RESUME_NO_SKIP 0x4000000
|
||||
#define JANET_FIBER_DID_LONGJUMP 0x8000000
|
||||
#define JANET_FIBER_FLAG_MASK 0xF000000
|
||||
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
#define janet_fiber_set_status(f, s) do {\
|
||||
|
||||
101
src/core/gc.c
101
src/core/gc.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "symcache.h"
|
||||
@@ -28,26 +29,24 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
struct JanetScratch {
|
||||
JanetScratchFinalizer finalize;
|
||||
long long mem[]; /* for proper alignment */
|
||||
};
|
||||
|
||||
/* GC State */
|
||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
|
||||
|
||||
/* Roots */
|
||||
JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch Memory */
|
||||
#ifdef JANET_64
|
||||
#define SCRATCH_HDR_SIZE 16 /* smalloc must guarantee 16 byte alignment. */
|
||||
#elif JANET_32
|
||||
#define SCRATCH_HDR_SIZE 8 /* smalloc must guarantee 8 byte alignment. */
|
||||
#else
|
||||
#error "unknown scratch alignment"
|
||||
#endif
|
||||
JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
@@ -64,9 +63,14 @@ static void janet_mark_string(const uint8_t *str);
|
||||
static void janet_mark_fiber(JanetFiber *fiber);
|
||||
static void janet_mark_abstract(void *adata);
|
||||
|
||||
/* Local state that is only temporary */
|
||||
/* Local state that is only temporary for gc */
|
||||
static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD;
|
||||
static JANET_THREAD_LOCAL uint32_t orig_rootcount;
|
||||
static JANET_THREAD_LOCAL size_t orig_rootcount;
|
||||
|
||||
/* Hint to the GC that we may need to collect */
|
||||
void janet_gcpressure(size_t s) {
|
||||
janet_vm_next_collection += s;
|
||||
}
|
||||
|
||||
/* Mark a value */
|
||||
void janet_mark(Janet x) {
|
||||
@@ -347,18 +351,18 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
mem->flags = type;
|
||||
|
||||
/* Prepend block to heap list */
|
||||
janet_vm_next_collection += (int32_t) size;
|
||||
janet_vm_next_collection += size;
|
||||
mem->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mem;
|
||||
|
||||
return (void *)mem;
|
||||
}
|
||||
|
||||
static void free_one_scratch(void *mem) {
|
||||
ScratchFinalizer finalize = *(ScratchFinalizer *)mem;
|
||||
if (finalize)
|
||||
finalize((char *)mem + SCRATCH_HDR_SIZE);
|
||||
free(mem);
|
||||
static void free_one_scratch(JanetScratch *s) {
|
||||
if (NULL != s->finalize) {
|
||||
s->finalize((char *) s->mem);
|
||||
}
|
||||
free(s);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
@@ -369,6 +373,11 @@ static void janet_free_all_scratch(void) {
|
||||
janet_scratch_len = 0;
|
||||
}
|
||||
|
||||
static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
JanetScratch *s = (JanetScratch *)mem;
|
||||
return s - 1;
|
||||
}
|
||||
|
||||
/* Run garbage collection */
|
||||
void janet_collect(void) {
|
||||
uint32_t i;
|
||||
@@ -390,9 +399,9 @@ void janet_collect(void) {
|
||||
* and all of its children. If gcroot is called on a value n times, unroot
|
||||
* must also be called n times to remove it as a gc root. */
|
||||
void janet_gcroot(Janet root) {
|
||||
uint32_t newcount = janet_vm_root_count + 1;
|
||||
size_t newcount = janet_vm_root_count + 1;
|
||||
if (newcount > janet_vm_root_capacity) {
|
||||
uint32_t newcap = 2 * newcount;
|
||||
size_t newcap = 2 * newcount;
|
||||
janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm_roots) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -472,36 +481,46 @@ void janet_gcunlock(int handle) {
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
void *mem = malloc(SCRATCH_HDR_SIZE + size);
|
||||
if (NULL == mem) {
|
||||
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
|
||||
if (NULL == s) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
*(ScratchFinalizer *)mem = NULL;
|
||||
s->finalize = NULL;
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
|
||||
JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_cap = newcap;
|
||||
janet_scratch_mem = newmem;
|
||||
}
|
||||
janet_scratch_mem[janet_scratch_len++] = mem;
|
||||
return (char *)mem + SCRATCH_HDR_SIZE;
|
||||
janet_scratch_mem[janet_scratch_len++] = s;
|
||||
return (char *)(s->mem);
|
||||
}
|
||||
|
||||
void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
if (nmemb && size > SIZE_MAX / nmemb) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
size_t n = nmemb * size;
|
||||
void *p = janet_smalloc(n);
|
||||
memset(p, 0, n);
|
||||
return p;
|
||||
}
|
||||
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
void *newmem = realloc(mem, size + SCRATCH_HDR_SIZE);
|
||||
if (NULL == newmem) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_mem[i] = newmem;
|
||||
return (char *)newmem + SCRATCH_HDR_SIZE;
|
||||
janet_scratch_mem[i] = news;
|
||||
return (char *)(news->mem);
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
@@ -509,19 +528,19 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
janet_exit("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, ScratchFinalizer finalizer) {
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
*(ScratchFinalizer *)mem = finalizer;
|
||||
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
s->finalize = finalizer;
|
||||
}
|
||||
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
free_one_scratch(mem);
|
||||
free_one_scratch(s);
|
||||
return;
|
||||
}
|
||||
if (i == 0) break;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#define JANET_GC_H
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose & contributors
|
||||
* Copyright (c) 2020 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,6 +27,7 @@
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
@@ -39,6 +40,24 @@
|
||||
static int it_s64_get(void *p, Janet key, Janet *out);
|
||||
static int it_u64_get(void *p, Janet key, Janet *out);
|
||||
|
||||
static int32_t janet_int64_hash(void *p1, size_t size) {
|
||||
(void) size;
|
||||
int32_t *words = p1;
|
||||
return words[0] ^ words[1];
|
||||
}
|
||||
|
||||
static int janet_int64_compare(void *p1, void *p2) {
|
||||
int64_t x = *((int64_t *)p1);
|
||||
int64_t y = *((int64_t *)p2);
|
||||
return x == y ? 0 : x < y ? -1 : 1;
|
||||
}
|
||||
|
||||
static int janet_uint64_compare(void *p1, void *p2) {
|
||||
uint64_t x = *((uint64_t *)p1);
|
||||
uint64_t y = *((uint64_t *)p2);
|
||||
return x == y ? 0 : x < y ? -1 : 1;
|
||||
}
|
||||
|
||||
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_int64(ctx, *((int64_t *)p));
|
||||
@@ -70,7 +89,10 @@ static const JanetAbstractType it_s64_type = {
|
||||
NULL,
|
||||
int64_marshal,
|
||||
int64_unmarshal,
|
||||
it_s64_tostring
|
||||
it_s64_tostring,
|
||||
janet_int64_compare,
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
static const JanetAbstractType it_u64_type = {
|
||||
@@ -81,7 +103,10 @@ static const JanetAbstractType it_u64_type = {
|
||||
NULL,
|
||||
int64_marshal,
|
||||
int64_unmarshal,
|
||||
it_u64_tostring
|
||||
it_u64_tostring,
|
||||
janet_uint64_compare,
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
@@ -177,49 +202,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
for (int32_t i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
@@ -227,18 +253,18 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
@@ -248,11 +274,43 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
*box = janet_unwrap_s64(argv[0]);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
int64_t value = janet_unwrap_s64(argv[i]);
|
||||
if (value == 0) janet_panic("division by zero");
|
||||
int64_t x = *box % value;
|
||||
if (x < 0) {
|
||||
x = (*box < 0) ? x - *box : x + *box;
|
||||
}
|
||||
*box = x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
if (x < 0) {
|
||||
x = (op1 < 0) ? x - op1 : x + op1;
|
||||
}
|
||||
*box = x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
@@ -267,9 +325,12 @@ COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
@@ -289,65 +350,63 @@ COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
{"-", cfun_it_s64_sub},
|
||||
{"r-", cfun_it_s64_subi},
|
||||
{"*", cfun_it_s64_mul},
|
||||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"%", cfun_it_s64_mod},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
{">=", cfun_it_s64_ge},
|
||||
{"==", cfun_it_s64_eq},
|
||||
{"=", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
|
||||
{"+!", cfun_it_s64_add_mut},
|
||||
{"-!", cfun_it_s64_sub_mut},
|
||||
{"*!", cfun_it_s64_mul_mut},
|
||||
{"/!", cfun_it_s64_div_mut},
|
||||
{"%!", cfun_it_s64_mod_mut},
|
||||
{"&!", cfun_it_s64_and_mut},
|
||||
{"|!", cfun_it_s64_or_mut},
|
||||
{"^!", cfun_it_s64_xor_mut},
|
||||
{"<<!", cfun_it_s64_lshift_mut},
|
||||
{">>!", cfun_it_s64_rshift_mut},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod it_u64_methods[] = {
|
||||
{"+", cfun_it_u64_add},
|
||||
{"r+", cfun_it_u64_add},
|
||||
{"-", cfun_it_u64_sub},
|
||||
{"r-", cfun_it_u64_subi},
|
||||
{"*", cfun_it_u64_mul},
|
||||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
{">=", cfun_it_u64_ge},
|
||||
{"==", cfun_it_u64_eq},
|
||||
{"=", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
|
||||
{"+!", cfun_it_u64_add_mut},
|
||||
{"-!", cfun_it_u64_sub_mut},
|
||||
{"*!", cfun_it_u64_mul_mut},
|
||||
{"/!", cfun_it_u64_div_mut},
|
||||
{"%!", cfun_it_u64_mod_mut},
|
||||
{"&!", cfun_it_u64_and_mut},
|
||||
{"|!", cfun_it_u64_or_mut},
|
||||
{"^!", cfun_it_u64_xor_mut},
|
||||
{"<<!", cfun_it_u64_lshift_mut},
|
||||
{">>!", cfun_it_u64_rshift_mut},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
165
src/core/io.c
165
src/core/io.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,32 +20,19 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Compiler feature test macros for things */
|
||||
#define _DEFAULT_SOURCE
|
||||
#define _BSD_SOURCE
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <sys/wait.h>
|
||||
#endif
|
||||
|
||||
#define IO_WRITE 1
|
||||
#define IO_READ 2
|
||||
#define IO_APPEND 4
|
||||
#define IO_UPDATE 8
|
||||
#define IO_NOT_CLOSEABLE 16
|
||||
#define IO_CLOSED 32
|
||||
#define IO_BINARY 64
|
||||
#define IO_SERIALIZABLE 128
|
||||
#define IO_PIPED 256
|
||||
|
||||
typedef struct IOFile IOFile;
|
||||
struct IOFile {
|
||||
FILE *file;
|
||||
@@ -60,10 +47,7 @@ JanetAbstractType cfun_io_filetype = {
|
||||
cfun_io_gc,
|
||||
NULL,
|
||||
io_file_get,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* Check arguments to fopen */
|
||||
@@ -78,13 +62,13 @@ static int checkflags(const uint8_t *str) {
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
break;
|
||||
case 'w':
|
||||
flags |= IO_WRITE;
|
||||
flags |= JANET_FILE_WRITE;
|
||||
break;
|
||||
case 'a':
|
||||
flags |= IO_APPEND;
|
||||
flags |= JANET_FILE_APPEND;
|
||||
break;
|
||||
case 'r':
|
||||
flags |= IO_READ;
|
||||
flags |= JANET_FILE_READ;
|
||||
break;
|
||||
}
|
||||
for (i = 1; i < len; i++) {
|
||||
@@ -93,12 +77,12 @@ static int checkflags(const uint8_t *str) {
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & IO_UPDATE) return -1;
|
||||
flags |= IO_UPDATE;
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
flags |= JANET_FILE_UPDATE;
|
||||
break;
|
||||
case 'b':
|
||||
if (flags & IO_BINARY) return -1;
|
||||
flags |= IO_BINARY;
|
||||
if (flags & JANET_FILE_BINARY) return -1;
|
||||
flags |= JANET_FILE_BINARY;
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -132,10 +116,10 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE);
|
||||
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_PIPED | IO_READ;
|
||||
flags = JANET_FILE_PIPED | JANET_FILE_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define popen _popen
|
||||
@@ -148,6 +132,15 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
FILE *tmp = tmpfile();
|
||||
if (!tmp)
|
||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
||||
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
||||
}
|
||||
|
||||
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
@@ -158,45 +151,15 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_READ;
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const int fd = janet_getinteger(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fdopen _fdopen
|
||||
#endif
|
||||
FILE *f = fdopen(fd, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fileno _fileno
|
||||
#endif
|
||||
return janet_wrap_integer(fileno(iof->file));
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not readable");
|
||||
janet_buffer_extra(buffer, nBytesMax);
|
||||
size_t ntoread = nBytesMax;
|
||||
@@ -210,7 +173,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||
JanetBuffer *buffer;
|
||||
if (argc == 2) {
|
||||
buffer = janet_buffer(0);
|
||||
@@ -250,9 +213,9 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
int32_t i;
|
||||
/* Verify all arguments before writing to file */
|
||||
@@ -273,9 +236,9 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
if (fflush(iof->file))
|
||||
janet_panic("could not flush file");
|
||||
@@ -286,7 +249,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
IOFile *iof = (IOFile *)p;
|
||||
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
return fclose(iof->file);
|
||||
}
|
||||
return 0;
|
||||
@@ -296,22 +259,22 @@ static int cfun_io_gc(void *p, size_t len) {
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (iof->flags & (IO_NOT_CLOSEABLE))
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
return janet_wrap_nil();
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & IO_PIPED) {
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= IO_CLOSED;
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
} else {
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
iof->flags |= IO_CLOSED;
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
@@ -320,7 +283,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
int whence = SEEK_CUR;
|
||||
@@ -345,7 +308,6 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
|
||||
static JanetMethod io_file_methods[] = {
|
||||
{"close", cfun_io_fclose},
|
||||
{"fileno", cfun_io_fileno},
|
||||
{"flush", cfun_io_fflush},
|
||||
{"read", cfun_io_fread},
|
||||
{"seek", cfun_io_fseek},
|
||||
@@ -579,6 +541,12 @@ static const JanetReg io_cfuns[] = {
|
||||
JDOC("(eprinf fmt & xs)\n\n"
|
||||
"Like eprintf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"file/temp", cfun_io_temp,
|
||||
JDOC("(file/temp)\n\n"
|
||||
"Open an anonymous temporary file that is removed on close."
|
||||
"Raises an error on failure.")
|
||||
},
|
||||
{
|
||||
"file/open", cfun_io_fopen,
|
||||
JDOC("(file/open path &opt mode)\n\n"
|
||||
@@ -593,32 +561,13 @@ static const JanetReg io_cfuns[] = {
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fdopen", cfun_io_fdopen,
|
||||
JDOC("(file/fdopen fd &opt mode)\n\n"
|
||||
"Create a file from an fd. fd is a platform specific file descriptor, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fileno", cfun_io_fileno,
|
||||
JDOC("(file/fileno f)\n\n"
|
||||
"Return the underlying file descriptor for the file as a number."
|
||||
"The meaning of this number is platform specific.")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
JDOC("(file/close f)\n\n"
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file.")
|
||||
"other processes read the file. If the file is the result of a file/popen "
|
||||
"call, close waits for and returns the process exit status.")
|
||||
},
|
||||
{
|
||||
"file/read", cfun_io_fread,
|
||||
@@ -674,21 +623,35 @@ FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkfile(Janet j) {
|
||||
return janet_checkabstract(j, &cfun_io_filetype);
|
||||
}
|
||||
|
||||
FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
IOFile *iof = janet_unwrap_abstract(j);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, io_cfuns);
|
||||
|
||||
/* stdout */
|
||||
janet_core_def(env, "stdout",
|
||||
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
janet_core_def(env, "stderr",
|
||||
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
janet_core_def(env, "stdin",
|
||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard input file."));
|
||||
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "vector.h"
|
||||
@@ -94,8 +95,8 @@ void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix
|
||||
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
|
||||
int32_t oldlen = janet_string_length(oldsym);
|
||||
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
|
||||
memcpy(symbuf, prefix, prelen);
|
||||
memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
safe_memcpy(symbuf, prefix, prelen);
|
||||
safe_memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
Janet s = janet_symbolv(symbuf, prelen + oldlen);
|
||||
janet_sfree(symbuf);
|
||||
janet_table_put(renv, s, entry_getval(env->data[i].value));
|
||||
@@ -692,7 +693,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
janet_panic("invalid funcenv length");
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
env->as.values = malloc(sizeof(Janet) * length);
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -797,7 +798,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal environments */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
|
||||
def->environments = calloc(1, sizeof(int32_t) * environments_length);
|
||||
def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
if (!def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -811,7 +812,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal sub funcdefs */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
|
||||
def->defs = calloc(1, sizeof(JanetFuncDef *) * defs_length);
|
||||
def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
if (!def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -826,7 +827,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
/* Unmarshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
int32_t current = 0;
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * bytecode_length);
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
if (!def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1016,7 +1017,7 @@ uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data + len - 1);
|
||||
memcpy(dest, ctx->data, len);
|
||||
safe_memcpy(dest, ctx->data, len);
|
||||
ctx->data += len;
|
||||
}
|
||||
|
||||
@@ -1138,7 +1139,7 @@ static const uint8_t *unmarshal_one(
|
||||
} else { /* (lead == LB_BUFFER) */
|
||||
JanetBuffer *buffer = janet_buffer(len);
|
||||
buffer->count = len;
|
||||
memcpy(buffer->data, data, len);
|
||||
safe_memcpy(buffer->data, data, len);
|
||||
*out = janet_wrap_buffer(buffer);
|
||||
}
|
||||
janet_v_push(st->lookup, *out);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,13 +20,14 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <math.h>
|
||||
|
||||
static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
|
||||
|
||||
static int janet_rng_get(void *p, Janet key, Janet *out);
|
||||
@@ -59,7 +60,7 @@ static JanetAbstractType JanetRNG_type = {
|
||||
NULL,
|
||||
janet_rng_marshal,
|
||||
janet_rng_unmarshal,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
@@ -222,13 +223,6 @@ static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(fmod(x, y));
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
@@ -280,11 +274,6 @@ static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"%", janet_remainder,
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor.")
|
||||
},
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
|
||||
128
src/core/os.c
128
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,12 +21,14 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include <fcntl.h>
|
||||
#include <errno.h>
|
||||
@@ -50,6 +52,9 @@
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
extern char **environ;
|
||||
#ifdef JANET_THREADS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* For macos */
|
||||
@@ -58,6 +63,40 @@ extern char **environ;
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
|
||||
/* Setting C99 standard makes this not available, but it should
|
||||
* work/link properly if we detect a BSD */
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
/* Access to some global variables should be synchronized if not in single threaded mode, as
|
||||
* setenv/getenv are not thread safe. */
|
||||
#ifdef JANET_THREADS
|
||||
# ifdef JANET_WINDOWS
|
||||
static int env_lock_initialized = 0;
|
||||
static CRITICAL_SECTION env_lock;
|
||||
static void janet_lock_environ(void) {
|
||||
EnterCriticalSection(&env_lock);
|
||||
}
|
||||
static void janet_unlock_environ(void) {
|
||||
LeaveCriticalSection(&env_lock);
|
||||
}
|
||||
# else
|
||||
static pthread_mutex_t env_lock = PTHREAD_MUTEX_INITIALIZER;
|
||||
static void janet_lock_environ(void) {
|
||||
pthread_mutex_lock(&env_lock);
|
||||
}
|
||||
static void janet_unlock_environ(void) {
|
||||
pthread_mutex_unlock(&env_lock);
|
||||
}
|
||||
# endif
|
||||
#else
|
||||
static void janet_lock_environ(void) {
|
||||
}
|
||||
static void janet_unlock_environ(void) {
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif /* JANET_REDCUED_OS */
|
||||
|
||||
/* Core OS functions */
|
||||
@@ -74,11 +113,11 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||
#elif defined(JANET_WINDOWS)
|
||||
return janet_ckeywordv("windows");
|
||||
#elif defined(__APPLE__)
|
||||
#elif defined(JANET_APPLE)
|
||||
return janet_ckeywordv("macos");
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
return janet_ckeywordv("web");
|
||||
#elif defined(__linux__)
|
||||
#elif defined(JANET_LINUX)
|
||||
return janet_ckeywordv("linux");
|
||||
#elif defined(__FreeBSD__)
|
||||
return janet_ckeywordv("freebsd");
|
||||
@@ -86,6 +125,8 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
||||
return janet_ckeywordv("netbsd");
|
||||
#elif defined(__OpenBSD__)
|
||||
return janet_ckeywordv("openbsd");
|
||||
#elif defined(JANET_BSD)
|
||||
return janet_ckeywordv("bsd");
|
||||
#else
|
||||
return janet_ckeywordv("posix");
|
||||
#endif
|
||||
@@ -101,7 +142,7 @@ static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
return janet_ckeywordv("wasm");
|
||||
#elif (defined(__x86_64__) || defined(_M_X64))
|
||||
return janet_ckeywordv("x86-64");
|
||||
return janet_ckeywordv("x64");
|
||||
#elif defined(__i386) || defined(_M_IX86)
|
||||
return janet_ckeywordv("x86");
|
||||
#elif defined(_M_ARM64) || defined(__aarch64__)
|
||||
@@ -120,13 +161,16 @@ static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
int status;
|
||||
if (argc == 0) {
|
||||
exit(EXIT_SUCCESS);
|
||||
status = EXIT_SUCCESS;
|
||||
} else if (janet_checkint(argv[0])) {
|
||||
exit(janet_unwrap_integer(argv[0]));
|
||||
status = janet_unwrap_integer(argv[0]);
|
||||
} else {
|
||||
exit(EXIT_FAILURE);
|
||||
status = EXIT_FAILURE;
|
||||
}
|
||||
janet_deinit();
|
||||
exit(status);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -135,7 +179,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -147,7 +191,7 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
char **envp = NULL;
|
||||
if (argc > 2) {
|
||||
JanetDictView dict = janet_getdictionary(argv, 2);
|
||||
envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
|
||||
envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
|
||||
int32_t j = 0;
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
@@ -166,7 +210,7 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
}
|
||||
}
|
||||
if (skip) continue;
|
||||
char *envitem = janet_smalloc(klen + vlen + 2);
|
||||
char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
|
||||
memcpy(envitem, keys, klen);
|
||||
envitem[klen] = '=';
|
||||
memcpy(envitem + klen + 1, vals, vlen);
|
||||
@@ -322,13 +366,13 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
|
||||
/* Check error */
|
||||
if (-1 == status) {
|
||||
janet_panic(strerror(errno));
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
}
|
||||
|
||||
return janet_wrap_integer(status);
|
||||
#else
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
|
||||
for (int32_t i = 0; i < exargs.len; i++)
|
||||
child_argv[i] = janet_getcstring(exargs.items, i);
|
||||
child_argv[exargs.len] = NULL;
|
||||
@@ -351,7 +395,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
/* Wait for child */
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panic(strerror(status));
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
} else {
|
||||
waitpid(pid, &status, 0);
|
||||
}
|
||||
@@ -376,6 +420,7 @@ static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
int32_t nenv = 0;
|
||||
janet_lock_environ();
|
||||
char **env = environ;
|
||||
while (*env++)
|
||||
nenv += 1;
|
||||
@@ -383,7 +428,10 @@ static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
for (int32_t i = 0; i < nenv; i++) {
|
||||
char *e = environ[i];
|
||||
char *eq = strchr(e, '=');
|
||||
if (!eq) janet_panic("no '=' in environ");
|
||||
if (!eq) {
|
||||
janet_unlock_environ();
|
||||
janet_panic("no '=' in environ");
|
||||
}
|
||||
char *v = eq + 1;
|
||||
int32_t full_len = (int32_t) strlen(e);
|
||||
int32_t val_len = (int32_t) strlen(v);
|
||||
@@ -393,16 +441,22 @@ static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
janet_stringv((const uint8_t *)v, val_len)
|
||||
);
|
||||
}
|
||||
janet_unlock_environ();
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
return res
|
||||
? janet_cstringv(res)
|
||||
: janet_wrap_nil();
|
||||
janet_lock_environ();
|
||||
Janet ret = res
|
||||
? janet_cstringv(res)
|
||||
: argc == 2
|
||||
? argv[1]
|
||||
: janet_wrap_nil();
|
||||
janet_unlock_environ();
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
@@ -415,11 +469,14 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *ks = janet_getcstring(argv, 0);
|
||||
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
||||
const char *vs = janet_optcstring(argv, argc, 1, NULL);
|
||||
janet_lock_environ();
|
||||
if (NULL == vs) {
|
||||
UNSETENV(ks);
|
||||
} else {
|
||||
SETENV(ks, janet_getcstring(argv, 1));
|
||||
SETENV(ks, vs);
|
||||
}
|
||||
janet_unlock_environ();
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -526,11 +583,9 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
#elif defined(__linux__) || defined(__APPLE__)
|
||||
#elif defined(JANET_LINUX)
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros. Macos may support
|
||||
arc4random_buf, but it needs investigation.
|
||||
|
||||
to be uniformly supported on linux distros.
|
||||
In both cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
@@ -548,10 +603,11 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
n -= nread;
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
#elif defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
|
||||
(void) errmsg;
|
||||
#elif defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
(void) genericerr;
|
||||
arc4random_buf(buffer->data + offset, n);
|
||||
#else
|
||||
(void) genericerr;
|
||||
janet_panic("cryptorand currently unsupported on this platform");
|
||||
#endif
|
||||
return janet_wrap_buffer(buffer);
|
||||
@@ -915,14 +971,9 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:netbsd\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{
|
||||
"os/environ", os_environ,
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
JDOC("(os/getenv variable &opt dflt)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
@@ -938,6 +989,11 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:unknown\n")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/environ", os_environ,
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
@@ -1074,5 +1130,13 @@ static const JanetReg os_cfuns[] = {
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_os(JanetTable *env) {
|
||||
#if !defined(JANET_REDUCED_OS) && defined(JANET_WINDOWS) && defined(JANET_THREADS)
|
||||
/* During start up, the top-most abstract machine (thread)
|
||||
* in the thread tree sets up the critical section. */
|
||||
if (!env_lock_initialized) {
|
||||
InitializeCriticalSection(&env_lock);
|
||||
env_lock_initialized = 1;
|
||||
}
|
||||
#endif
|
||||
janet_core_cfuns(env, NULL, os_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
@@ -687,20 +688,19 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
if (dest->bufcap) {
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
}
|
||||
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
|
||||
return;
|
||||
|
||||
nomem:
|
||||
@@ -737,10 +737,7 @@ static JanetAbstractType janet_parse_parsertype = {
|
||||
parsergc,
|
||||
parsermark,
|
||||
parserget,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* C Function parser */
|
||||
@@ -793,6 +790,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
p->column--;
|
||||
s = p->states + p->statecount - 1;
|
||||
}
|
||||
if (s->flags & PFLAG_COMMENT) s--;
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
s->argn++;
|
||||
if (p->statecount == 1) p->pending++;
|
||||
@@ -809,7 +807,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
}
|
||||
p->bufcap = newcap;
|
||||
}
|
||||
memcpy(p->buf + p->bufcount, str, slen);
|
||||
safe_memcpy(p->buf + p->bufcount, str, slen);
|
||||
p->bufcount = newcount;
|
||||
} else {
|
||||
janet_panic("cannot insert value into parser");
|
||||
@@ -892,7 +890,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
JanetArray *container_args = janet_array(s->argn);
|
||||
container_args->count = s->argn;
|
||||
memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
janet_table_put(state, janet_ckeywordv("args"),
|
||||
janet_wrap_array(container_args));
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include <string.h>
|
||||
#include "util.h"
|
||||
@@ -347,9 +348,9 @@ tail:
|
||||
if (!result) return NULL;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
JanetArray *sub_captures = janet_array(num_sub_captures);
|
||||
memcpy(sub_captures->data,
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
safe_memcpy(sub_captures->data,
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
sub_captures->count = num_sub_captures;
|
||||
cap_load(s, cs);
|
||||
pushcap(s, janet_wrap_array(sub_captures), tag);
|
||||
@@ -445,6 +446,7 @@ tail:
|
||||
|
||||
typedef struct {
|
||||
JanetTable *grammar;
|
||||
JanetTable *default_grammar;
|
||||
JanetTable *tags;
|
||||
Janet *constants;
|
||||
uint32_t *bytecode;
|
||||
@@ -726,6 +728,13 @@ static void spec_opt(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_BETWEEN, 0, 1, subrule);
|
||||
}
|
||||
|
||||
static void spec_repeat(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 2);
|
||||
Reserve r = reserve(b, 4);
|
||||
int32_t n = peg_getnat(b, argv[0]);
|
||||
uint32_t subrule = peg_compile1(b, argv[1]);
|
||||
emit_3(r, RULE_BETWEEN, n, n, subrule);
|
||||
}
|
||||
|
||||
/* Rule of the form [rule] */
|
||||
static void spec_onerule(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||
@@ -868,6 +877,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"position", spec_position},
|
||||
{"quote", spec_capture},
|
||||
{"range", spec_range},
|
||||
{"repeat", spec_repeat},
|
||||
{"replace", spec_replace},
|
||||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
@@ -886,9 +896,14 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
int i = JANET_RECURSION_GUARD;
|
||||
JanetTable *grammar = old_grammar;
|
||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
||||
peg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(peg, JANET_NIL))
|
||||
peg_panic(b, "unknown rule");
|
||||
Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
|
||||
nextPeg = janet_table_get(b->default_grammar, peg);
|
||||
if (janet_checktype(nextPeg, JANET_NIL)) {
|
||||
peg_panic(b, "unknown rule");
|
||||
}
|
||||
}
|
||||
peg = nextPeg;
|
||||
b->form = peg;
|
||||
b->grammar = grammar;
|
||||
}
|
||||
@@ -1039,7 +1054,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
size_t bytecode_size = bytecode_len * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
size_t total_size = constants_start + sizeof(Janet) * num_constants;
|
||||
size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants;
|
||||
|
||||
/* DOS prevention? I.E. we could read bytecode and constants before
|
||||
* hand so we don't allocated a ton of memory on bad, short input */
|
||||
@@ -1187,15 +1202,17 @@ bad:
|
||||
janet_panic("invalid peg bytecode");
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
|
||||
|
||||
static const JanetAbstractType peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
NULL,
|
||||
cfun_peg_getter,
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Convert Builder to Peg (Janet Abstract Value) */
|
||||
@@ -1210,8 +1227,8 @@ static Peg *make_peg(Builder *b) {
|
||||
peg->bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
peg->constants = (Janet *)(mem + constants_start);
|
||||
peg->num_constants = janet_v_count(b->constants);
|
||||
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
memcpy(peg->constants, b->constants, constants_size);
|
||||
safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
safe_memcpy(peg->constants, b->constants, constants_size);
|
||||
peg->bytecode_len = janet_v_count(b->bytecode);
|
||||
return peg;
|
||||
}
|
||||
@@ -1220,6 +1237,7 @@ static Peg *make_peg(Builder *b) {
|
||||
static Peg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
builder.tags = janet_table(0);
|
||||
builder.constants = NULL;
|
||||
builder.bytecode = NULL;
|
||||
@@ -1276,6 +1294,15 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
(void) a;
|
||||
if (janet_keyeq(key, "match")) {
|
||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static const JanetReg peg_cfuns[] = {
|
||||
{
|
||||
"peg/compile", cfun_peg_compile,
|
||||
|
||||
270
src/core/pp.c
270
src/core/pp.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,15 +20,17 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
* is simple and not that flexible, but fast. */
|
||||
|
||||
@@ -175,53 +177,50 @@ static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
|
||||
}
|
||||
|
||||
static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||
if (bx == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(bx, bx->count + 5 * bx->count + 3, 1);
|
||||
}
|
||||
janet_buffer_push_u8(buffer, '@');
|
||||
janet_escape_string_impl(buffer, bx->data, bx->count);
|
||||
}
|
||||
|
||||
void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
return;
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
janet_buffer_push_cstring(buffer,
|
||||
janet_unwrap_boolean(x) ? "true" : "false");
|
||||
return;
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
number_to_string_b(buffer, janet_unwrap_number(x));
|
||||
return;
|
||||
case JANET_KEYWORD:
|
||||
janet_buffer_push_u8(buffer, ':');
|
||||
/* fallthrough */
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
janet_buffer_push_bytes(buffer,
|
||||
janet_unwrap_string(x),
|
||||
janet_string_length(janet_unwrap_string(x)));
|
||||
return;
|
||||
case JANET_STRING:
|
||||
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
||||
return;
|
||||
break;
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||
if (b == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(b, 5 * b->count + 3, 1);
|
||||
}
|
||||
janet_escape_buffer_b(buffer, b);
|
||||
return;
|
||||
JanetBuffer *to = janet_unwrap_buffer(x);
|
||||
/* Prevent resizing buffer while appending */
|
||||
if (buffer == to) janet_buffer_extra(buffer, to->count);
|
||||
janet_buffer_push_bytes(buffer, to->data, to->count);
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *p = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(p);
|
||||
if (at->tostring) {
|
||||
at->tostring(p, buffer);
|
||||
JanetAbstract p = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *t = janet_abstract_type(p);
|
||||
if (t->tostring != NULL) {
|
||||
t->tostring(p, buffer);
|
||||
} else {
|
||||
const char *n = at->name;
|
||||
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
||||
string_description_b(buffer, t->name, p);
|
||||
}
|
||||
return;
|
||||
}
|
||||
return;
|
||||
case JANET_CFUNCTION: {
|
||||
Janet check = janet_table_get(janet_vm_registry, x);
|
||||
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||
@@ -253,26 +252,58 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
}
|
||||
}
|
||||
|
||||
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
/* See parse.c for full table */
|
||||
|
||||
static const uint32_t pp_symchars[8] = {
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||
0x00000000, 0x00000000, 0x00000000, 0x00000000
|
||||
};
|
||||
|
||||
static int pp_is_symbol_char(uint8_t c) {
|
||||
return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||
}
|
||||
|
||||
/* Check if a symbol or keyword contains no symbol characters */
|
||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||
int32_t len = janet_string_length(sym);
|
||||
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if (!pp_is_symbol_char(sym[i])) return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_description_b(buffer, x);
|
||||
break;
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *to = janet_unwrap_buffer(x);
|
||||
/* Prevent resizing buffer while appending */
|
||||
if (buffer == to) janet_buffer_extra(buffer, to->count);
|
||||
janet_buffer_push_bytes(buffer, to->data, to->count);
|
||||
break;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
janet_buffer_push_bytes(buffer,
|
||||
janet_unwrap_string(x),
|
||||
janet_string_length(janet_unwrap_string(x)));
|
||||
janet_buffer_push_u8(buffer, ':');
|
||||
break;
|
||||
case JANET_STRING:
|
||||
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
||||
return;
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||
janet_escape_buffer_b(buffer, b);
|
||||
return;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract p = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *t = janet_abstract_type(p);
|
||||
if (t->tostring != NULL) {
|
||||
janet_buffer_push_cstring(buffer, "<");
|
||||
janet_buffer_push_cstring(buffer, t->name);
|
||||
janet_buffer_push_cstring(buffer, " ");
|
||||
t->tostring(p, buffer);
|
||||
janet_buffer_push_cstring(buffer, ">");
|
||||
} else {
|
||||
string_description_b(buffer, t->name, p);
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_to_string_b(buffer, x);
|
||||
}
|
||||
|
||||
const uint8_t *janet_description(Janet x) {
|
||||
@@ -315,6 +346,83 @@ struct pretty {
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
/* Print jdn format */
|
||||
static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
if (depth == 0) return 1;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
case JANET_BOOLEAN:
|
||||
case JANET_BUFFER:
|
||||
case JANET_STRING:
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_TUPLE: {
|
||||
JanetTuple t = janet_unwrap_tuple(x);
|
||||
int isb = janet_tuple_flag(t) & JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
janet_buffer_push_u8(S->buffer, isb ? '[' : '(');
|
||||
for (int32_t i = 0; i < janet_tuple_length(t); i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, t[i], depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, isb ? ']' : ')');
|
||||
}
|
||||
break;
|
||||
case JANET_ARRAY: {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetArray *a = janet_unwrap_array(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@[");
|
||||
for (int32_t i = 0; i < a->count; i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, a->data[i], depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, ']');
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE: {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetTable *tab = janet_unwrap_table(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@{");
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < tab->capacity; i++) {
|
||||
const JanetKV *kv = tab->data + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
isFirst = 0;
|
||||
if (print_jdn_one(S, kv->key, depth - 1)) return 1;
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, kv->value, depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
}
|
||||
break;
|
||||
case JANET_STRUCT: {
|
||||
JanetStruct st = janet_unwrap_struct(x);
|
||||
janet_buffer_push_u8(S->buffer, '{');
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
const JanetKV *kv = st + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
isFirst = 0;
|
||||
if (print_jdn_one(S, kv->key, depth - 1)) return 1;
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, kv->value, depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
}
|
||||
break;
|
||||
default:
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void print_newline(struct pretty *S, int just_a_space) {
|
||||
int i;
|
||||
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
|
||||
@@ -329,6 +437,7 @@ static void print_newline(struct pretty *S, int just_a_space) {
|
||||
|
||||
/* Color coding for types */
|
||||
static const char janet_cycle_color[] = "\x1B[36m";
|
||||
static const char janet_class_color[] = "\x1B[34m";
|
||||
static const char *janet_pretty_colors[] = {
|
||||
"\x1B[32m",
|
||||
"\x1B[36m",
|
||||
@@ -350,6 +459,8 @@ static const char *janet_pretty_colors[] = {
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
#define JANET_PRETTY_DICT_LIMIT 16
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 16
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
@@ -416,9 +527,22 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < len; i++) {
|
||||
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT) {
|
||||
for (i = 0; i < 3; i++) {
|
||||
if (i) print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
}
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
for (i = 0; i < 3; i++) {
|
||||
print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[len - 3 + i], 0);
|
||||
}
|
||||
} else {
|
||||
for (i = 0; i < len; i++) {
|
||||
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
S->indent -= 2;
|
||||
@@ -436,10 +560,17 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
JanetTable *proto = t->proto;
|
||||
if (NULL != proto) {
|
||||
Janet name = janet_table_get(proto, janet_csymbolv(":name"));
|
||||
if (janet_checktype(name, JANET_SYMBOL)) {
|
||||
const uint8_t *sym = janet_unwrap_symbol(name);
|
||||
janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym));
|
||||
Janet name = janet_table_get(proto, janet_ckeywordv("name"));
|
||||
const uint8_t *n;
|
||||
int32_t len;
|
||||
if (janet_bytes_view(name, &n, &len)) {
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_class_color);
|
||||
}
|
||||
janet_buffer_push_bytes(S->buffer, n, len);
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
}
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "{");
|
||||
@@ -453,8 +584,9 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
int32_t i = 0, len = 0, cap = 0;
|
||||
int first_kv_pair = 1;
|
||||
const JanetKV *kvs = NULL;
|
||||
int counter = 0;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
if (!istable && len >= JANET_PRETTY_DICT_ONELINE)
|
||||
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < cap; i++) {
|
||||
@@ -467,6 +599,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_pretty_one(S, kvs[i].key, 0);
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[i].value, 1);
|
||||
counter++;
|
||||
if (counter == 10) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -503,6 +641,29 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) {
|
||||
struct pretty S;
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_buffer(0);
|
||||
}
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.flags = 0;
|
||||
S.bufstartlen = startlen;
|
||||
janet_table_init(&S.seen, 10);
|
||||
int res = print_jdn_one(&S, x, depth);
|
||||
janet_table_deinit(&S.seen);
|
||||
if (res) {
|
||||
janet_panic("could not print to jdn format");
|
||||
}
|
||||
return S.buffer;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) {
|
||||
return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static const char *typestr(Janet x) {
|
||||
JanetType t = janet_type(x);
|
||||
return (t == JANET_ABSTRACT)
|
||||
@@ -748,6 +909,13 @@ void janet_buffer_format(
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
janet_jdn_(b, depth, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
/* also treat cases 'nLlh' */
|
||||
janet_panicf("invalid conversion '%s' to 'format'",
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "regalloc.h"
|
||||
#include "util.h"
|
||||
@@ -66,7 +67,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
|
||||
dest->count = src->count;
|
||||
dest->capacity = src->capacity;
|
||||
dest->max = src->max;
|
||||
size = sizeof(uint32_t) * dest->capacity;
|
||||
size = sizeof(uint32_t) * (size_t) dest->capacity;
|
||||
dest->regtemps = 0;
|
||||
if (size) {
|
||||
dest->chunks = malloc(size);
|
||||
@@ -86,7 +87,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
|
||||
int32_t newcount = ra->count + 1;
|
||||
if (newcount > ra->capacity) {
|
||||
int32_t newcapacity = newcount * 2;
|
||||
ra->chunks = realloc(ra->chunks, newcapacity * sizeof(uint32_t));
|
||||
ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
if (!ra->chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "compile.h"
|
||||
#include "util.h"
|
||||
@@ -537,6 +538,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (not= nil _) */
|
||||
static int janetc_check_notnil_form(Janet x, Janet *capture) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(tup[0]);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != JANET_FUN_NEQ) return 0;
|
||||
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
@@ -553,6 +568,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
JanetScope tempscope;
|
||||
int32_t labelwt, labeld, labeljt, labelc, i;
|
||||
int infinite = 0;
|
||||
int is_notnil_form = 0;
|
||||
uint8_t ifjmp = JOP_JUMP_IF;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
|
||||
if (argn < 2) {
|
||||
janetc_cerror(c, "expected at least 2 arguments");
|
||||
@@ -563,13 +581,26 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||
|
||||
/* Check for `(not= nil _)` in condition, and if so, use the
|
||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
||||
* more efficiently. */
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_notnil_form(condform, &condform)) {
|
||||
is_notnil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
}
|
||||
|
||||
/* Compile condition */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
cond = janetc_value(subopts, condform);
|
||||
|
||||
/* Check for constant condition */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
/* Loop never executes */
|
||||
if (!janet_truthy(cond.constant)) {
|
||||
int never_executes = is_notnil_form
|
||||
? janet_checktype(cond.constant, JANET_NIL)
|
||||
: !janet_truthy(cond.constant);
|
||||
if (never_executes) {
|
||||
janetc_popscope(c);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
@@ -580,7 +611,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Infinite loop does not need to check condition */
|
||||
labelc = infinite
|
||||
? 0
|
||||
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
: janetc_emit_si(c, ifnjmp, cond, 0, 0);
|
||||
|
||||
/* Compile body */
|
||||
for (i = 1; i < argn; i++) {
|
||||
@@ -599,10 +630,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
|
||||
|
||||
/* Recompile in the function scope */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
cond = janetc_value(subopts, condform);
|
||||
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
||||
/* If not an infinite loop, return nil when condition false */
|
||||
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
||||
janetc_emit_si(c, ifjmp, cond, 2, 0);
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
}
|
||||
for (i = 1; i < argn; i++) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -32,6 +32,8 @@
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
typedef struct JanetScratch JanetScratch;
|
||||
|
||||
/* Cache the core environment */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
|
||||
@@ -59,17 +61,17 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
|
||||
|
||||
/* Garbage collection */
|
||||
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
|
||||
|
||||
/* GC roots */
|
||||
extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
extern JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,18 +20,19 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Begin building a string */
|
||||
uint8_t *janet_string_begin(int32_t length) {
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) length + 1);
|
||||
head->length = length;
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
data[length] = 0;
|
||||
@@ -46,11 +47,11 @@ const uint8_t *janet_string_end(uint8_t *str) {
|
||||
|
||||
/* Load a buffer as a string */
|
||||
const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) len + 1);
|
||||
head->length = len;
|
||||
head->hash = janet_string_calchash(buf, len);
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
memcpy(data, buf, len);
|
||||
safe_memcpy(data, buf, len);
|
||||
data[len] = 0;
|
||||
return data;
|
||||
}
|
||||
@@ -186,7 +187,7 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
uint8_t *newbuf = janet_string_begin((int32_t) mulres);
|
||||
uint8_t *end = newbuf + mulres;
|
||||
for (uint8_t *p = newbuf; p < end; p += view.len) {
|
||||
memcpy(p, view.bytes, view.len);
|
||||
safe_memcpy(p, view.bytes, view.len);
|
||||
}
|
||||
return janet_wrap_string(janet_string_end(newbuf));
|
||||
}
|
||||
@@ -342,11 +343,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(s.kmp.text, s.kmp.textlen);
|
||||
}
|
||||
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
|
||||
memcpy(buf, s.kmp.text, result);
|
||||
memcpy(buf + result, s.subst, s.substlen);
|
||||
memcpy(buf + result + s.substlen,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
safe_memcpy(buf, s.kmp.text, result);
|
||||
safe_memcpy(buf + result, s.subst, s.substlen);
|
||||
safe_memcpy(buf + result + s.substlen,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
kmp_deinit(&s.kmp);
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
@@ -444,11 +445,11 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
|
||||
const uint8_t *chunk = NULL;
|
||||
int32_t chunklen = 0;
|
||||
if (i) {
|
||||
memcpy(out, joiner.bytes, joiner.len);
|
||||
safe_memcpy(out, joiner.bytes, joiner.len);
|
||||
out += joiner.len;
|
||||
}
|
||||
janet_bytes_view(parts.items[i], &chunk, &chunklen);
|
||||
memcpy(out, chunk, chunklen);
|
||||
safe_memcpy(out, chunk, chunklen);
|
||||
out += chunklen;
|
||||
}
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -40,14 +40,15 @@
|
||||
* '0xdeadbeef'.
|
||||
*/
|
||||
|
||||
#include <math.h>
|
||||
#include <string.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <math.h>
|
||||
#include <string.h>
|
||||
|
||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
||||
static uint8_t digit_lookup[128] = {
|
||||
@@ -86,7 +87,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
|
||||
int32_t newn = oldn + n;
|
||||
if (mant->cap < newn) {
|
||||
int32_t newcap = 2 * newn;
|
||||
uint32_t *mem = realloc(mant->digits, newcap * sizeof(uint32_t));
|
||||
uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -446,12 +447,16 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
if (neg && bi <= 0x8000000000000000ULL) {
|
||||
*out = -((int64_t) bi);
|
||||
if (neg && bi <= (UINT64_MAX / 2)) {
|
||||
if (bi > INT64_MAX) {
|
||||
*out = INT64_MIN;
|
||||
} else {
|
||||
*out = -((int64_t) bi);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
|
||||
*out = bi;
|
||||
if (!neg && bi <= INT64_MAX) {
|
||||
*out = (int64_t) bi;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
@@ -33,7 +34,7 @@ JanetKV *janet_struct_begin(int32_t count) {
|
||||
int32_t capacity = janet_tablen(2 * count);
|
||||
if (capacity < 0) capacity = janet_tablen(count + 1);
|
||||
|
||||
size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
|
||||
size_t size = sizeof(JanetStructHead) + (size_t) capacity * sizeof(JanetKV);
|
||||
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
|
||||
head->length = count;
|
||||
head->capacity = capacity;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,9 +25,8 @@
|
||||
* checks, all symbols are interned so that there is a single copy of it in the
|
||||
* whole program. Equality is then just a pointer check. */
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
@@ -35,6 +34,8 @@
|
||||
#include "symcache.h"
|
||||
#endif
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Cache state */
|
||||
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0;
|
||||
@@ -44,7 +45,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
||||
/* Initialize the cache (allocate cache memory) */
|
||||
void janet_symcache_init() {
|
||||
janet_vm_cache_capacity = 1024;
|
||||
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
janet_vm_cache = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm_cache) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -121,7 +122,7 @@ notfound:
|
||||
static void janet_cache_resize(uint32_t newCapacity) {
|
||||
uint32_t i, oldCapacity;
|
||||
const uint8_t **oldCache = janet_vm_cache;
|
||||
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t *));
|
||||
const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
if (newCache == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -178,11 +179,11 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
||||
if (success)
|
||||
return *bucket;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + (size_t) len + 1);
|
||||
head->hash = hash;
|
||||
head->length = len;
|
||||
newstr = (uint8_t *)(head->data);
|
||||
memcpy(newstr, str, len);
|
||||
safe_memcpy(newstr, str, len);
|
||||
newstr[len] = 0;
|
||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||
return newstr;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#define JANET_SYMCACHE_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
@@ -31,7 +32,7 @@
|
||||
|
||||
static void *janet_memalloc_empty_local(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = janet_smalloc(count * sizeof(JanetKV));
|
||||
void *mem = janet_smalloc((size_t) count * sizeof(JanetKV));
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
@@ -240,7 +241,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
|
||||
if (NULL == newTable->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newTable->data, table->data, table->capacity * sizeof(JanetKV));
|
||||
memcpy(newTable->data, table->data, (size_t) table->capacity * sizeof(JanetKV));
|
||||
return newTable;
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
@@ -29,6 +30,7 @@
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
#include <math.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
@@ -49,9 +51,6 @@ struct JanetMailbox {
|
||||
pthread_cond_t cond;
|
||||
#endif
|
||||
|
||||
/* Receiving messages - (only by owner thread) */
|
||||
JanetTable *decode;
|
||||
|
||||
/* Setup procedure - requires a parent mailbox
|
||||
* to receive thunk from */
|
||||
JanetMailbox *parent;
|
||||
@@ -73,9 +72,18 @@ struct JanetMailbox {
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
|
||||
static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
|
||||
|
||||
static JanetTable *janet_thread_get_decode(void) {
|
||||
if (janet_vm_thread_decode == NULL) {
|
||||
janet_vm_thread_decode = janet_get_core_table("load-image-dict");
|
||||
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
|
||||
}
|
||||
return janet_vm_thread_decode;
|
||||
}
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * capacity);
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -183,11 +191,11 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
||||
waiter->timedwait = 0;
|
||||
waiter->nowait = 0;
|
||||
|
||||
if (sec == 0.0 || isnan(sec)) {
|
||||
if (sec <= 0.0 || isnan(sec)) {
|
||||
waiter->nowait = 1;
|
||||
return;
|
||||
}
|
||||
waiter->timedwait = sec > 0.0;
|
||||
waiter->timedwait = sec > 0.0 && !isinf(sec);
|
||||
|
||||
/* Set maximum wait time to 30 days */
|
||||
if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
|
||||
@@ -354,7 +362,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
0, mailbox->decode, &nextItem);
|
||||
0, janet_thread_get_decode(), &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
@@ -368,7 +376,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
}
|
||||
}
|
||||
|
||||
if (wait.nowait || mailbox->refCount <= 1) {
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
@@ -389,10 +397,7 @@ static JanetAbstractType Thread_AT = {
|
||||
thread_gc,
|
||||
thread_mark,
|
||||
janet_thread_getter,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
@@ -406,15 +411,6 @@ JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
|
||||
}
|
||||
|
||||
static JanetTable *janet_get_core_table(const char *name) {
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
Janet out = janet_wrap_nil();
|
||||
JanetBindingType bt = janet_resolve(env, janet_csymbol(name), &out);
|
||||
if (bt == JANET_BINDING_NONE) return NULL;
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailbox *mailbox) {
|
||||
JanetFiber *fiber = NULL;
|
||||
@@ -428,7 +424,6 @@ static int thread_worker(JanetMailbox *mailbox) {
|
||||
|
||||
/* Get dictionaries for default encode/decode */
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
mailbox->decode = janet_get_core_table("load-image-dict");
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
|
||||
@@ -438,7 +433,7 @@ static int thread_worker(JanetMailbox *mailbox) {
|
||||
|
||||
/* Unmarshal the function */
|
||||
Janet funcv;
|
||||
int status = janet_thread_receive(&funcv, -1.0);
|
||||
int status = janet_thread_receive(&funcv, INFINITY);
|
||||
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
|
||||
@@ -471,7 +466,7 @@ error:
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static DWORD janet_create_thread_wrapper(void *param) {
|
||||
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
return 0;
|
||||
}
|
||||
@@ -512,6 +507,8 @@ void janet_threads_init(void) {
|
||||
if (NULL == janet_vm_mailbox) {
|
||||
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
|
||||
}
|
||||
janet_vm_thread_decode = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
}
|
||||
|
||||
void janet_threads_deinit(void) {
|
||||
@@ -520,6 +517,7 @@ void janet_threads_deinit(void) {
|
||||
janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
|
||||
janet_vm_mailbox = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
janet_vm_thread_decode = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -538,8 +536,10 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
int32_t cap = janet_optinteger(argv, argc, 0, 10);
|
||||
janet_arity(argc, 1, 2);
|
||||
/* Just type checking */
|
||||
janet_getfunction(argv, 0);
|
||||
int32_t cap = janet_optinteger(argv, argc, 1, 10);
|
||||
if (cap < 1 || cap > UINT16_MAX) {
|
||||
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
|
||||
}
|
||||
@@ -555,6 +555,12 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
/* If thread started, send the worker function. */
|
||||
if (janet_thread_send(thread, argv[0], INFINITY)) {
|
||||
janet_panicf("could not send worker function %v to thread", argv[0]);
|
||||
}
|
||||
|
||||
return janet_wrap_abstract(thread);
|
||||
}
|
||||
|
||||
@@ -614,9 +620,9 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new &opt capacity)\n\n"
|
||||
"Start a new thread. The thread will wait for a message containing the function used to start the thread, which should be passed to the thread "
|
||||
"via thread/send. If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
|
||||
JDOC("(thread/new func &opt capacity)\n\n"
|
||||
"Start a new thread that will start immediately. "
|
||||
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
|
||||
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
@@ -31,7 +32,7 @@
|
||||
* which should be filled with Janets. The memory will not be collected until
|
||||
* janet_tuple_end is called. */
|
||||
Janet *janet_tuple_begin(int32_t length) {
|
||||
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||
size_t size = sizeof(JanetTupleHead) + ((size_t) length * sizeof(Janet));
|
||||
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||
head->sm_line = -1;
|
||||
head->sm_column = -1;
|
||||
@@ -48,7 +49,7 @@ const Janet *janet_tuple_end(Janet *tuple) {
|
||||
/* Build a tuple with n values */
|
||||
const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
Janet *t = janet_tuple_begin(n);
|
||||
memcpy(t, values, sizeof(Janet) * n);
|
||||
safe_memcpy(t, values, sizeof(Janet) * n);
|
||||
return janet_tuple_end(t);
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose & contributors
|
||||
* Copyright (c) 2020 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
@@ -118,7 +119,7 @@ static const JanetAbstractType ta_buffer_type = {
|
||||
NULL,
|
||||
ta_buffer_marshal,
|
||||
ta_buffer_unmarshal,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
static int ta_mark(void *p, size_t s) {
|
||||
@@ -282,7 +283,7 @@ static const JanetAbstractType ta_view_type = {
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
|
||||
187
src/core/util.c
187
src/core/util.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,15 +20,16 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
#include <inttypes.h>
|
||||
|
||||
/* Base 64 lookup table for digits */
|
||||
const char janet_base64[65] =
|
||||
"0123456789"
|
||||
@@ -93,7 +94,7 @@ const char *const janet_status_names[16] = {
|
||||
"alive"
|
||||
};
|
||||
|
||||
/* Calculate hash for string */
|
||||
#ifdef JANET_NO_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
const uint8_t *end = str + len;
|
||||
@@ -103,6 +104,118 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
return (int32_t) hash;
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
/*
|
||||
Public domain siphash implementation sourced from:
|
||||
|
||||
https://raw.githubusercontent.com/veorq/SipHash/master/halfsiphash.c
|
||||
|
||||
We have made a few alterations, such as hardcoding the output size
|
||||
and then removing dead code.
|
||||
*/
|
||||
#define cROUNDS 2
|
||||
#define dROUNDS 4
|
||||
|
||||
#define ROTL(x, b) (uint32_t)(((x) << (b)) | ((x) >> (32 - (b))))
|
||||
|
||||
#define U8TO32_LE(p) \
|
||||
(((uint32_t)((p)[0])) | ((uint32_t)((p)[1]) << 8) | \
|
||||
((uint32_t)((p)[2]) << 16) | ((uint32_t)((p)[3]) << 24))
|
||||
|
||||
#define SIPROUND \
|
||||
do { \
|
||||
v0 += v1; \
|
||||
v1 = ROTL(v1, 5); \
|
||||
v1 ^= v0; \
|
||||
v0 = ROTL(v0, 16); \
|
||||
v2 += v3; \
|
||||
v3 = ROTL(v3, 8); \
|
||||
v3 ^= v2; \
|
||||
v0 += v3; \
|
||||
v3 = ROTL(v3, 7); \
|
||||
v3 ^= v0; \
|
||||
v2 += v1; \
|
||||
v1 = ROTL(v1, 13); \
|
||||
v1 ^= v2; \
|
||||
v2 = ROTL(v2, 16); \
|
||||
} while (0)
|
||||
|
||||
static uint32_t halfsiphash(const uint8_t *in, const size_t inlen, const uint8_t *k) {
|
||||
|
||||
uint32_t v0 = 0;
|
||||
uint32_t v1 = 0;
|
||||
uint32_t v2 = UINT32_C(0x6c796765);
|
||||
uint32_t v3 = UINT32_C(0x74656462);
|
||||
uint32_t k0 = U8TO32_LE(k);
|
||||
uint32_t k1 = U8TO32_LE(k + 4);
|
||||
uint32_t m;
|
||||
int i;
|
||||
const uint8_t *end = in + inlen - (inlen % sizeof(uint32_t));
|
||||
const int left = inlen & 3;
|
||||
uint32_t b = ((uint32_t)inlen) << 24;
|
||||
v3 ^= k1;
|
||||
v2 ^= k0;
|
||||
v1 ^= k1;
|
||||
v0 ^= k0;
|
||||
|
||||
for (; in != end; in += 4) {
|
||||
m = U8TO32_LE(in);
|
||||
v3 ^= m;
|
||||
|
||||
for (i = 0; i < cROUNDS; ++i)
|
||||
SIPROUND;
|
||||
|
||||
v0 ^= m;
|
||||
}
|
||||
|
||||
switch (left) {
|
||||
case 3:
|
||||
b |= ((uint32_t)in[2]) << 16;
|
||||
/* fallthrough */
|
||||
case 2:
|
||||
b |= ((uint32_t)in[1]) << 8;
|
||||
/* fallthrough */
|
||||
case 1:
|
||||
b |= ((uint32_t)in[0]);
|
||||
break;
|
||||
case 0:
|
||||
break;
|
||||
}
|
||||
|
||||
v3 ^= b;
|
||||
|
||||
for (i = 0; i < cROUNDS; ++i)
|
||||
SIPROUND;
|
||||
|
||||
v0 ^= b;
|
||||
|
||||
v2 ^= 0xff;
|
||||
|
||||
for (i = 0; i < dROUNDS; ++i)
|
||||
SIPROUND;
|
||||
|
||||
b = v1 ^ v3;
|
||||
return b;
|
||||
}
|
||||
/* end of siphash */
|
||||
|
||||
static uint8_t hash_key[JANET_HASH_KEY_SIZE] = {0};
|
||||
|
||||
void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) {
|
||||
memcpy(hash_key, new_key, sizeof(hash_key));
|
||||
}
|
||||
|
||||
/* Calculate hash for string */
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
uint32_t hash;
|
||||
hash = halfsiphash(str, len, hash_key);
|
||||
return (int32_t)hash;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len) {
|
||||
const Janet *end = array + len;
|
||||
@@ -135,6 +248,12 @@ int32_t janet_tablen(int32_t n) {
|
||||
return n + 1;
|
||||
}
|
||||
|
||||
/* Avoid some undefined behavior that was common in the code base. */
|
||||
void safe_memcpy(void *dest, const void *src, size_t len) {
|
||||
if (!len) return;
|
||||
memcpy(dest, src, len);
|
||||
}
|
||||
|
||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||
* containing the key, or the first empty bucket if there is no such key. */
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
@@ -262,40 +381,51 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
|
||||
/* Load many cfunctions at once */
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
uint8_t *longname_buffer = NULL;
|
||||
size_t prefixlen = 0;
|
||||
size_t bufsize = 0;
|
||||
if (NULL != regprefix) {
|
||||
prefixlen = strlen(regprefix);
|
||||
bufsize = prefixlen + 256;
|
||||
longname_buffer = malloc(bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
safe_memcpy(longname_buffer, regprefix, prefixlen);
|
||||
longname_buffer[prefixlen] = '/';
|
||||
prefixlen++;
|
||||
}
|
||||
while (cfuns->name) {
|
||||
Janet name = janet_csymbolv(cfuns->name);
|
||||
Janet longname = name;
|
||||
if (regprefix) {
|
||||
int32_t reglen = 0;
|
||||
Janet name;
|
||||
if (NULL != regprefix) {
|
||||
int32_t nmlen = 0;
|
||||
while (regprefix[reglen]) reglen++;
|
||||
while (cfuns->name[nmlen]) nmlen++;
|
||||
int32_t symlen = reglen + 1 + nmlen;
|
||||
uint8_t *longname_buffer = malloc(symlen);
|
||||
memcpy(longname_buffer, regprefix, reglen);
|
||||
longname_buffer[reglen] = '/';
|
||||
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
||||
longname = janet_wrap_symbol(janet_symbol(longname_buffer, symlen));
|
||||
free(longname_buffer);
|
||||
int32_t totallen = (int32_t) prefixlen + nmlen;
|
||||
if ((size_t) totallen > bufsize) {
|
||||
bufsize = (size_t)(totallen) + 128;
|
||||
longname_buffer = realloc(longname_buffer, bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
|
||||
} else {
|
||||
name = janet_csymbolv(cfuns->name);
|
||||
}
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_table_put(janet_vm_registry, fun, longname);
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
free(longname_buffer);
|
||||
}
|
||||
|
||||
/* Abstract type introspection */
|
||||
|
||||
static const JanetAbstractType type_wrap = {
|
||||
"core/type-info",
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_NAME
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
@@ -448,3 +578,12 @@ int janet_checksize(Janet x) {
|
||||
return dval == (double)((size_t) dval) &&
|
||||
dval <= SIZE_MAX;
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
Janet out = janet_wrap_nil();
|
||||
JanetBindingType bt = janet_resolve(env, janet_csymbol(name), &out);
|
||||
if (bt == JANET_BINDING_NONE) return NULL;
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,13 +23,14 @@
|
||||
#ifndef JANET_UTIL_H_defined
|
||||
#define JANET_UTIL_H_defined
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
@@ -67,11 +68,13 @@ int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
||||
int32_t janet_tablen(int32_t n);
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
|
||||
122
src/core/value.c
122
src/core/value.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,8 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include "util.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
@@ -28,6 +30,87 @@
|
||||
* Define a number of functions that can be used internally on ANY Janet.
|
||||
*/
|
||||
|
||||
Janet janet_next(Janet ds, Janet key) {
|
||||
JanetType t = janet_type(ds);
|
||||
switch (t) {
|
||||
default:
|
||||
janet_panicf("expected iterable type, got %v", ds);
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *start;
|
||||
int32_t cap;
|
||||
if (t == JANET_TABLE) {
|
||||
JanetTable *tab = janet_unwrap_table(ds);
|
||||
cap = tab->capacity;
|
||||
start = tab->data;
|
||||
} else {
|
||||
JanetStruct st = janet_unwrap_struct(ds);
|
||||
cap = janet_struct_capacity(st);
|
||||
start = st;
|
||||
}
|
||||
const JanetKV *end = start + cap;
|
||||
const JanetKV *kv = janet_checktype(key, JANET_NIL)
|
||||
? start
|
||||
: janet_dict_find(start, cap, key) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_BUFFER:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t i;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
i = 0;
|
||||
} else if (janet_checkint(key)) {
|
||||
i = janet_unwrap_integer(key) + 1;
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
int32_t len;
|
||||
if (t == JANET_BUFFER) {
|
||||
len = janet_unwrap_buffer(ds)->count;
|
||||
} else if (t == JANET_ARRAY) {
|
||||
len = janet_unwrap_array(ds)->count;
|
||||
} else if (t == JANET_TUPLE) {
|
||||
len = janet_tuple_length(janet_unwrap_tuple(ds));
|
||||
} else {
|
||||
len = janet_string_length(janet_unwrap_string(ds));
|
||||
}
|
||||
if (i < len && i >= 0) {
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract abst = janet_unwrap_abstract(ds);
|
||||
const JanetAbstractType *at = janet_abstract_type(abst);
|
||||
if (NULL == at->next) break;
|
||||
return at->next(abst, key);
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Compare two abstract values */
|
||||
static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
if (xx == yy) return 0;
|
||||
const JanetAbstractType *xt = janet_abstract_type(xx);
|
||||
const JanetAbstractType *yt = janet_abstract_type(yy);
|
||||
if (xt != yt) {
|
||||
return xt > yt ? 1 : -1;
|
||||
}
|
||||
if (xt->compare == NULL) {
|
||||
return xx > yy ? 1 : -1;
|
||||
}
|
||||
return xt->compare(xx, yy);
|
||||
}
|
||||
|
||||
/* Check if two values are equal. This is strict equality with no conversion. */
|
||||
int janet_equals(Janet x, Janet y) {
|
||||
int result = 0;
|
||||
@@ -53,6 +136,9 @@ int janet_equals(Janet x, Janet y) {
|
||||
case JANET_STRUCT:
|
||||
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
break;
|
||||
case JANET_ABSTRACT:
|
||||
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
break;
|
||||
default:
|
||||
/* compare pointers */
|
||||
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
|
||||
@@ -83,6 +169,15 @@ int32_t janet_hash(Janet x) {
|
||||
case JANET_STRUCT:
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract xx = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(xx);
|
||||
if (at->hash != NULL) {
|
||||
hash = at->hash(xx, janet_abstract_size(xx));
|
||||
break;
|
||||
}
|
||||
}
|
||||
/* fallthrough */
|
||||
default:
|
||||
/* TODO - test performance with different hash functions */
|
||||
if (sizeof(double) == sizeof(void *)) {
|
||||
@@ -104,7 +199,7 @@ int32_t janet_hash(Janet x) {
|
||||
|
||||
/* Compares x to y. If they are equal returns 0. If x is less, returns -1.
|
||||
* If y is less, returns 1. All types are comparable
|
||||
* and should have strict ordering. */
|
||||
* and should have strict ordering, excepts NaNs. */
|
||||
int janet_compare(Janet x, Janet y) {
|
||||
if (janet_type(x) == janet_type(y)) {
|
||||
switch (janet_type(x)) {
|
||||
@@ -112,20 +207,13 @@ int janet_compare(Janet x, Janet y) {
|
||||
return 0;
|
||||
case JANET_BOOLEAN:
|
||||
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
case JANET_NUMBER:
|
||||
/* Check for NaNs to ensure total order */
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||
return janet_unwrap_number(y) != janet_unwrap_number(y)
|
||||
? 0
|
||||
: -1;
|
||||
if (janet_unwrap_number(y) != janet_unwrap_number(y))
|
||||
return 1;
|
||||
|
||||
if (janet_unwrap_number(x) == janet_unwrap_number(y)) {
|
||||
return 0;
|
||||
} else {
|
||||
return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1;
|
||||
}
|
||||
case JANET_NUMBER: {
|
||||
double xx = janet_unwrap_number(x);
|
||||
double yy = janet_unwrap_number(y);
|
||||
return xx == yy
|
||||
? 0
|
||||
: (xx < yy) ? -1 : 1;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
@@ -134,6 +222,8 @@ int janet_compare(Janet x, Janet y) {
|
||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
case JANET_STRUCT:
|
||||
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
case JANET_ABSTRACT:
|
||||
return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
default:
|
||||
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
|
||||
return 0;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
@@ -40,18 +41,14 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||
/* Convert a buffer to normal allocated memory (forget capacity) */
|
||||
void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
int32_t *p;
|
||||
int32_t sizen;
|
||||
if (NULL == v) return NULL;
|
||||
sizen = itemsize * janet_v__cnt(v);
|
||||
p = malloc(sizen);
|
||||
size_t size = (size_t) itemsize * janet_v__cnt(v);
|
||||
p = malloc(size);
|
||||
if (NULL != p) {
|
||||
memcpy(p, v, sizen);
|
||||
safe_memcpy(p, v, size);
|
||||
return p;
|
||||
} else {
|
||||
{
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
return NULL;
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#define JANET_VECTOR_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
|
||||
356
src/core/vm.c
356
src/core/vm.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "fiber.h"
|
||||
@@ -117,12 +118,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define vm_binop_immediate(op)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
stack[A] = janet_wrap_number(x1 op CS);\
|
||||
@@ -132,10 +132,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
@@ -143,71 +149,110 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, op2 };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = wrap(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
|
||||
#define _vm_bitop(op, type1)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
#define vm_compop(op) \
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = janet_wrap_boolean(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func) {
|
||||
Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
|
||||
int32_t start = janet_vm_fiber->stackstart;
|
||||
int32_t end = janet_vm_fiber->stacktop;
|
||||
int32_t argc = end - start;
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", stack[i]);
|
||||
janet_printf(" %p", argv[i]);
|
||||
}
|
||||
printf(")\n");
|
||||
janet_printf(")\n");
|
||||
}
|
||||
|
||||
/* Call a non function type */
|
||||
/* Invoke a method once we have looked it up */
|
||||
static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
|
||||
switch (janet_type(method)) {
|
||||
case JANET_CFUNCTION:
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract abst = janet_unwrap_abstract(method);
|
||||
const JanetAbstractType *at = janet_abstract_type(abst);
|
||||
if (NULL != at->call) {
|
||||
return at->call(abst, argc, argv);
|
||||
}
|
||||
}
|
||||
/* fallthrough */
|
||||
case JANET_STRING:
|
||||
case JANET_BUFFER:
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
if (argc != 1) {
|
||||
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
|
||||
}
|
||||
return janet_in(method, argv[0]);
|
||||
}
|
||||
default: {
|
||||
if (argc != 1) {
|
||||
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
|
||||
}
|
||||
return janet_in(argv[0], method);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a non function type from a JOP_CALL or JOP_TAILCALL instruction.
|
||||
* Assumes that the arguments are on the fiber stack. */
|
||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||
Janet ds, key;
|
||||
if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
|
||||
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
||||
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
||||
ds = callee;
|
||||
key = fiber->data[fiber->stackstart];
|
||||
} else {
|
||||
ds = fiber->data[fiber->stackstart];
|
||||
key = callee;
|
||||
}
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
fiber->stacktop = fiber->stackstart;
|
||||
return janet_in(ds, key);
|
||||
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and check ensure that it is valid. */
|
||||
/* Get a callable from a keyword method name and ensure that it is valid. */
|
||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
||||
@@ -217,8 +262,33 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
return callee;
|
||||
}
|
||||
|
||||
/* Lookup method on value x */
|
||||
static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
Janet kname = janet_ckeywordv(name);
|
||||
return janet_get(x, kname);
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
if (janet_checktype(lm, JANET_NIL)) {
|
||||
/* Invert order for rmethod */
|
||||
Janet lr = janet_method_lookup(rhs, rmethod);
|
||||
Janet argv[2] = { rhs, lhs };
|
||||
if (janet_checktype(lr, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v, or :%s for %v",
|
||||
lmethod, lhs,
|
||||
rmethod, rhs);
|
||||
}
|
||||
return janet_method_invoke(lr, 2, argv);
|
||||
} else {
|
||||
Janet argv[2] = { lhs, rhs };
|
||||
return janet_method_invoke(lm, 2, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
/* opcode -> label lookup if using clang/GCC */
|
||||
#ifdef JANET_USE_COMPUTED_GOTOS
|
||||
@@ -235,6 +305,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_MODULO,
|
||||
&&label_JOP_REMAINDER,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
@@ -250,6 +322,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_JUMP_IF_NIL,
|
||||
&&label_JOP_JUMP_IF_NOT_NIL,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
@@ -288,13 +362,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
&&label_JOP_MAKE_TABLE,
|
||||
&&label_JOP_MAKE_TUPLE,
|
||||
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||
&&label_JOP_NUMERIC_LESS_THAN,
|
||||
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_JOP_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NEXT,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
@@ -487,29 +557,38 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
register JanetFunction *func;
|
||||
vm_restore();
|
||||
|
||||
/* Only should be hit if the fiber is either waiting for a child, or
|
||||
* waiting to be resumed. In those cases, use input and increment pc. We
|
||||
* DO NOT use input when resuming a fiber that has been interrupted at a
|
||||
* breakpoint. */
|
||||
uint8_t first_opcode;
|
||||
if (status != JANET_STATUS_NEW &&
|
||||
((*pc & 0xFF) == JOP_SIGNAL ||
|
||||
(*pc & 0xFF) == JOP_PROPAGATE ||
|
||||
(*pc & 0xFF) == JOP_RESUME)) {
|
||||
stack[A] = in;
|
||||
pc++;
|
||||
first_opcode = *pc & 0xFF;
|
||||
} else if (status == JANET_STATUS_DEBUG) {
|
||||
first_opcode = *pc & 0x7F;
|
||||
} else {
|
||||
first_opcode = *pc & 0xFF;
|
||||
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
|
||||
if (janet_fiber_frame(fiber)->func == NULL) {
|
||||
/* Inside a c function */
|
||||
janet_fiber_popframe(fiber);
|
||||
vm_restore();
|
||||
}
|
||||
/* Check if we were at a tail call instruction. If so, do implicit return */
|
||||
if ((*pc & 0xFF) == JOP_TAILCALL) {
|
||||
/* Tail call resume */
|
||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame) {
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_MASK;
|
||||
vm_return(JANET_SIGNAL_OK, in);
|
||||
}
|
||||
vm_restore();
|
||||
}
|
||||
}
|
||||
|
||||
if (!(fiber->flags & JANET_FIBER_RESUME_NO_USEVAL)) stack[A] = in;
|
||||
if (!(fiber->flags & JANET_FIBER_RESUME_NO_SKIP)) pc++;
|
||||
|
||||
uint8_t first_opcode = *pc & ((fiber->flags & JANET_FIBER_BREAKPOINT) ? 0x7F : 0xFF);
|
||||
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_MASK;
|
||||
|
||||
/* Main interpreter loop. Semantically is a switch on
|
||||
* (*pc & 0xFF) inside of an infinite loop. */
|
||||
VM_START();
|
||||
|
||||
VM_DEFAULT();
|
||||
fiber->flags |= JANET_FIBER_BREAKPOINT | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
vm_return(JANET_SIGNAL_DEBUG, janet_wrap_nil());
|
||||
|
||||
VM_OP(JOP_NOOP)
|
||||
@@ -557,27 +636,43 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
VM_OP(JOP_MULTIPLY)
|
||||
vm_binop(*);
|
||||
|
||||
VM_OP(JOP_NUMERIC_LESS_THAN)
|
||||
vm_numcomp( <);
|
||||
|
||||
VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL)
|
||||
vm_numcomp( <=);
|
||||
|
||||
VM_OP(JOP_NUMERIC_GREATER_THAN)
|
||||
vm_numcomp( >);
|
||||
|
||||
VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL)
|
||||
vm_numcomp( >=);
|
||||
|
||||
VM_OP(JOP_NUMERIC_EQUAL)
|
||||
vm_numcomp( ==);
|
||||
|
||||
VM_OP(JOP_DIVIDE_IMMEDIATE)
|
||||
vm_binop_immediate( /);
|
||||
|
||||
VM_OP(JOP_DIVIDE)
|
||||
vm_binop( /);
|
||||
|
||||
VM_OP(JOP_MODULO) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_REMAINDER) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
stack[A] = janet_wrap_number(fmod(x1, x2));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("%", "r%", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_BAND)
|
||||
vm_bitop(&);
|
||||
|
||||
@@ -640,17 +735,37 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NOT_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_LESS_THAN)
|
||||
stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) < 0);
|
||||
vm_pcnext();
|
||||
vm_compop( <);
|
||||
|
||||
VM_OP(JOP_LESS_THAN_EQUAL)
|
||||
vm_compop( <=);
|
||||
|
||||
VM_OP(JOP_LESS_THAN_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_GREATER_THAN)
|
||||
stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) > 0);
|
||||
vm_pcnext();
|
||||
vm_compop( >);
|
||||
|
||||
VM_OP(JOP_GREATER_THAN_EQUAL)
|
||||
vm_compop( >=);
|
||||
|
||||
VM_OP(JOP_GREATER_THAN_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
|
||||
@@ -668,6 +783,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NEXT)
|
||||
stack[A] = janet_next(stack[B], stack[C]);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_LOAD_NIL)
|
||||
stack[D] = janet_wrap_nil();
|
||||
vm_pcnext();
|
||||
@@ -735,7 +854,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
vm_assert(defindex < func->def->defs_length, "invalid funcdef");
|
||||
fd = func->def->defs[defindex];
|
||||
elen = fd->environments_length;
|
||||
fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + (elen * sizeof(JanetFuncEnv *)));
|
||||
fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + ((size_t) elen * sizeof(JanetFuncEnv *)));
|
||||
fn->def = fd;
|
||||
{
|
||||
int32_t i;
|
||||
@@ -799,7 +918,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -836,7 +957,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
}
|
||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -873,8 +996,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
fiber->child = child;
|
||||
JanetSignal sig = janet_continue(child, stack[C], &retreg);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
vm_return(sig, retreg);
|
||||
}
|
||||
fiber->child = NULL;
|
||||
stack = fiber->data + fiber->frame;
|
||||
stack[A] = retreg;
|
||||
@@ -898,18 +1022,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
janet_panicf("cannot propagate from fiber with status :%s",
|
||||
janet_status_names[sub_status]);
|
||||
}
|
||||
janet_vm_fiber->child = f;
|
||||
fiber->child = f;
|
||||
vm_return((int) sub_status, stack[B]);
|
||||
}
|
||||
|
||||
VM_OP(JOP_PUT)
|
||||
vm_commit();
|
||||
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
|
||||
janet_put(stack[A], stack[B], stack[C]);
|
||||
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
|
||||
vm_checkgc_pcnext();
|
||||
|
||||
VM_OP(JOP_PUT_INDEX)
|
||||
vm_commit();
|
||||
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
|
||||
janet_putindex(stack[A], C, stack[B]);
|
||||
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
|
||||
vm_checkgc_pcnext();
|
||||
|
||||
VM_OP(JOP_IN)
|
||||
@@ -1079,6 +1207,11 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
|
||||
janet_panic("C stack recursed too deeply");
|
||||
|
||||
/* Tracing */
|
||||
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(fun, argc, argv);
|
||||
}
|
||||
|
||||
/* Push frame */
|
||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||
@@ -1091,9 +1224,8 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
int handle = janet_gclock();
|
||||
|
||||
/* Run vm */
|
||||
JanetSignal signal = run_vm(janet_vm_fiber,
|
||||
janet_wrap_nil(),
|
||||
JANET_STATUS_ALIVE);
|
||||
janet_vm_fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
JanetSignal signal = run_vm(janet_vm_fiber, janet_wrap_nil());
|
||||
|
||||
/* Teardown */
|
||||
janet_vm_stackn = oldn;
|
||||
@@ -1153,10 +1285,16 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
|
||||
/* Run loop */
|
||||
JanetSignal signal;
|
||||
if (setjmp(buf)) {
|
||||
signal = JANET_SIGNAL_ERROR;
|
||||
int jmpsig;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
jmpsig = _setjmp(buf);
|
||||
#else
|
||||
jmpsig = setjmp(buf);
|
||||
#endif
|
||||
if (jmpsig) {
|
||||
signal = (JanetSignal) jmpsig;
|
||||
} else {
|
||||
signal = run_vm(fiber, in, old_status);
|
||||
signal = run_vm(fiber, in);
|
||||
}
|
||||
|
||||
/* Tear down fiber */
|
||||
@@ -1197,30 +1335,12 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
/* At least 1 argument */
|
||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
||||
/* Find method */
|
||||
Janet method;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
|
||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
||||
method = janet_table_get(table, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
|
||||
const JanetKV *st = janet_unwrap_struct(argv[0]);
|
||||
method = janet_struct_get(st, janet_ckeywordv(name));
|
||||
} else {
|
||||
Janet method = janet_method_lookup(argv[0], name);
|
||||
if (janet_checktype(method, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", name, argv[0]);
|
||||
}
|
||||
/* Invoke method */
|
||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
} else {
|
||||
janet_panicf("method %s has unexpected value %v", name, method);
|
||||
}
|
||||
return janet_method_invoke(method, argc, argv);
|
||||
}
|
||||
|
||||
/* Setup VM */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,8 +21,9 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <math.h>
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include <math.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
@@ -161,8 +162,8 @@ Janet(janet_wrap_number)(double x) {
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
janet_vm_next_collection += count * sizeof(JanetKV);
|
||||
void *mem = malloc((size_t) count * sizeof(JanetKV));
|
||||
janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -45,6 +45,22 @@ extern "C" {
|
||||
* detection for unsupported platforms
|
||||
*/
|
||||
|
||||
/* Check for any flavor of BSD (except apple) */
|
||||
#if defined(__FreeBSD__) || defined(__DragonFly__) || \
|
||||
defined(__NetBSD__) || defined(__OpenBSD__)
|
||||
#define JANET_BSD 1
|
||||
#endif
|
||||
|
||||
/* Check for Mac */
|
||||
#ifdef __APPLE__
|
||||
#define JANET_APPLE 1
|
||||
#endif
|
||||
|
||||
/* Check for Linux */
|
||||
#ifdef __linux__
|
||||
#define JANET_LINUX 1
|
||||
#endif
|
||||
|
||||
/* Check Unix */
|
||||
#if defined(_AIX) \
|
||||
|| defined(__APPLE__) /* Darwin */ \
|
||||
@@ -58,11 +74,7 @@ extern "C" {
|
||||
|| defined(__QNXNTO__) \
|
||||
|| defined(sun) || defined(__sun) /* Solaris */ \
|
||||
|| defined(unix) || defined(__unix) || defined(__unix__)
|
||||
#define JANET_UNIX 1
|
||||
/* Enable certain posix features */
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
#define JANET_POSIX 1
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
#define JANET_WEB 1
|
||||
#elif defined(WIN32) || defined(_WIN32)
|
||||
@@ -71,7 +83,7 @@ extern "C" {
|
||||
|
||||
/* Check 64-bit vs 32-bit */
|
||||
#if ((defined(__x86_64__) || defined(_M_X64)) \
|
||||
&& (defined(JANET_UNIX) || defined(JANET_WINDOWS))) \
|
||||
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
|
||||
|| (defined(_WIN64)) /* Windows 64 bit */ \
|
||||
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|
||||
|| defined(__alpha__) /* DEC Alpha */ \
|
||||
@@ -112,8 +124,10 @@ extern "C" {
|
||||
#define JANET_THREAD_LOCAL
|
||||
#elif defined(__GNUC__)
|
||||
#define JANET_THREAD_LOCAL __thread
|
||||
#define JANET_THREADS
|
||||
#elif defined(_MSC_BUILD)
|
||||
#define JANET_THREAD_LOCAL __declspec(thread)
|
||||
#define JANET_THREADS
|
||||
#else
|
||||
#define JANET_THREAD_LOCAL
|
||||
#endif
|
||||
@@ -143,11 +157,6 @@ extern "C" {
|
||||
#define JANET_INT_TYPES
|
||||
#endif
|
||||
|
||||
/* Enable or disable threads */
|
||||
#ifndef JANET_NO_THREADS
|
||||
#define JANET_THREADS
|
||||
#endif
|
||||
|
||||
/* How to export symbols */
|
||||
#ifndef JANET_API
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -245,6 +254,11 @@ typedef struct {
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#ifdef JANET_BSD
|
||||
int _setjmp(jmp_buf);
|
||||
JANET_NO_RETURN void _longjmp(jmp_buf, int);
|
||||
#endif
|
||||
|
||||
/* Names of all of the types */
|
||||
JANET_API extern const char *const janet_type_names[16];
|
||||
JANET_API extern const char *const janet_signal_names[14];
|
||||
@@ -666,6 +680,7 @@ struct Janet {
|
||||
JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
JANET_API int janet_checksize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
@@ -681,28 +696,6 @@ struct JanetGCObject {
|
||||
JanetGCObject *next;
|
||||
};
|
||||
|
||||
/* Fiber signal masks. */
|
||||
#define JANET_FIBER_MASK_ERROR 2
|
||||
#define JANET_FIBER_MASK_DEBUG 4
|
||||
#define JANET_FIBER_MASK_YIELD 8
|
||||
|
||||
#define JANET_FIBER_MASK_USER0 (16 << 0)
|
||||
#define JANET_FIBER_MASK_USER1 (16 << 1)
|
||||
#define JANET_FIBER_MASK_USER2 (16 << 2)
|
||||
#define JANET_FIBER_MASK_USER3 (16 << 3)
|
||||
#define JANET_FIBER_MASK_USER4 (16 << 4)
|
||||
#define JANET_FIBER_MASK_USER5 (16 << 5)
|
||||
#define JANET_FIBER_MASK_USER6 (16 << 6)
|
||||
#define JANET_FIBER_MASK_USER7 (16 << 7)
|
||||
#define JANET_FIBER_MASK_USER8 (16 << 8)
|
||||
#define JANET_FIBER_MASK_USER9 (16 << 9)
|
||||
|
||||
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
|
||||
#define JANET_FIBER_MASK_USER 0x3FF0
|
||||
|
||||
#define JANET_FIBER_STATUS_MASK 0xFF0000
|
||||
#define JANET_FIBER_STATUS_OFFSET 16
|
||||
|
||||
/* A lightweight green thread in janet. Does not correspond to
|
||||
* operating system threads. */
|
||||
struct JanetFiber {
|
||||
@@ -912,8 +905,29 @@ struct JanetAbstractType {
|
||||
void (*marshal)(void *p, JanetMarshalContext *ctx);
|
||||
void *(*unmarshal)(JanetMarshalContext *ctx);
|
||||
void (*tostring)(void *p, JanetBuffer *buffer);
|
||||
int (*compare)(void *lhs, void *rhs);
|
||||
int32_t (*hash)(void *p, size_t len);
|
||||
Janet(*next)(void *p, Janet key);
|
||||
Janet(*call)(void *p, int32_t argc, Janet *argv);
|
||||
};
|
||||
|
||||
/* Some macros to let us add extra types to JanetAbstract types without
|
||||
* needing to changing native modules that declare them as static const
|
||||
* structures. If more fields are added, these macros are modified to include
|
||||
* default values (usually NULL). This silences missing field warnings. */
|
||||
#define JANET_ATEND_NAME NULL,JANET_ATEND_GC
|
||||
#define JANET_ATEND_GC NULL,JANET_ATEND_GCMARK
|
||||
#define JANET_ATEND_GCMARK NULL,JANET_ATEND_GET
|
||||
#define JANET_ATEND_GET NULL,JANET_ATEND_PUT
|
||||
#define JANET_ATEND_PUT NULL,JANET_ATEND_MARSHAL
|
||||
#define JANET_ATEND_MARSHAL NULL,JANET_ATEND_UNMARSHAL
|
||||
#define JANET_ATEND_UNMARSHAL NULL,JANET_ATEND_TOSTRING
|
||||
#define JANET_ATEND_TOSTRING NULL,JANET_ATEND_COMPARE
|
||||
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
|
||||
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
|
||||
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
@@ -1010,6 +1024,8 @@ enum JanetOpCode {
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE,
|
||||
JOP_MODULO,
|
||||
JOP_REMAINDER,
|
||||
JOP_BAND,
|
||||
JOP_BOR,
|
||||
JOP_BXOR,
|
||||
@@ -1025,6 +1041,8 @@ enum JanetOpCode {
|
||||
JOP_JUMP,
|
||||
JOP_JUMP_IF,
|
||||
JOP_JUMP_IF_NOT,
|
||||
JOP_JUMP_IF_NIL,
|
||||
JOP_JUMP_IF_NOT_NIL,
|
||||
JOP_GREATER_THAN,
|
||||
JOP_GREATER_THAN_IMMEDIATE,
|
||||
JOP_LESS_THAN,
|
||||
@@ -1063,11 +1081,9 @@ enum JanetOpCode {
|
||||
JOP_MAKE_TABLE,
|
||||
JOP_MAKE_TUPLE,
|
||||
JOP_MAKE_BRACKET_TUPLE,
|
||||
JOP_NUMERIC_LESS_THAN,
|
||||
JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
JOP_NUMERIC_GREATER_THAN,
|
||||
JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
JOP_NUMERIC_EQUAL,
|
||||
JOP_GREATER_THAN_EQUAL,
|
||||
JOP_LESS_THAN_EQUAL,
|
||||
JOP_NEXT,
|
||||
JOP_INSTRUCTION_COUNT
|
||||
};
|
||||
|
||||
@@ -1298,6 +1314,7 @@ JANET_API int janet_gcunroot(Janet root);
|
||||
JANET_API int janet_gcunrootall(Janet root);
|
||||
JANET_API int janet_gclock(void);
|
||||
JANET_API void janet_gcunlock(int handle);
|
||||
JANET_API void janet_gcpressure(size_t s);
|
||||
|
||||
/* Functions */
|
||||
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
||||
@@ -1310,12 +1327,17 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
#ifndef JANET_NO_PRF
|
||||
#define JANET_HASH_KEY_SIZE 16
|
||||
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
|
||||
#endif
|
||||
JANET_API int janet_equals(Janet x, Janet y);
|
||||
JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(JanetString str, const char *other);
|
||||
JANET_API Janet janet_in(Janet ds, Janet key);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_next(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API Janet janet_lengthv(Janet x);
|
||||
@@ -1323,6 +1345,9 @@ JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
||||
JANET_API Janet janet_wrap_number_safe(double x);
|
||||
JANET_API int janet_keyeq(Janet x, const char *cstring);
|
||||
JANET_API int janet_streq(Janet x, const char *cstring);
|
||||
JANET_API int janet_symeq(Janet x, const char *cstring);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
@@ -1335,10 +1360,12 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
|
||||
/* Scratch Memory API */
|
||||
typedef void (*ScratchFinalizer)(void *);
|
||||
typedef void (*JanetScratchFinalizer)(void *);
|
||||
|
||||
JANET_API void *janet_smalloc(size_t size);
|
||||
JANET_API void *janet_srealloc(void *mem, size_t size);
|
||||
JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
|
||||
JANET_API void *janet_scalloc(size_t nmemb, size_t size);
|
||||
JANET_API void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer);
|
||||
JANET_API void janet_sfree(void *mem);
|
||||
|
||||
/* C Library helpers */
|
||||
@@ -1361,15 +1388,16 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
|
||||
/* Allow setting entry name for static libraries */
|
||||
#ifndef JANET_ENTRY_NAME
|
||||
#define JANET_ENTRY_NAME _janet_init
|
||||
#endif
|
||||
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_API void JANET_ENTRY_NAME
|
||||
JANET_API void _janet_init
|
||||
#else
|
||||
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
|
||||
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
|
||||
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
|
||||
JANET_NO_RETURN JANET_API void janet_panics(JanetString message);
|
||||
@@ -1440,8 +1468,21 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
#define JANET_FILE_WRITE 1
|
||||
#define JANET_FILE_READ 2
|
||||
#define JANET_FILE_APPEND 4
|
||||
#define JANET_FILE_UPDATE 8
|
||||
#define JANET_FILE_NOT_CLOSEABLE 16
|
||||
#define JANET_FILE_CLOSED 32
|
||||
#define JANET_FILE_BINARY 64
|
||||
#define JANET_FILE_SERIALIZABLE 128
|
||||
#define JANET_FILE_PIPED 256
|
||||
|
||||
JANET_API Janet janet_makefile(FILE *f, int flags);
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
JANET_API JanetAbstract janet_checkfile(Janet j);
|
||||
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
|
||||
|
||||
/* Marshal API */
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
|
||||
@@ -1,502 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "line.h"
|
||||
#endif
|
||||
|
||||
/* Common */
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 2);
|
||||
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
janet_line_get(str, buf);
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
buffer->count = 0;
|
||||
int c;
|
||||
for (;;) {
|
||||
c = fgetc(in);
|
||||
if (feof(in) || c < 0) {
|
||||
break;
|
||||
}
|
||||
janet_buffer_push_u8(buffer, (uint8_t) c);
|
||||
if (c == '\n') break;
|
||||
}
|
||||
}
|
||||
|
||||
/* Windows */
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_deinit() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
fputs(p, out);
|
||||
fflush(out);
|
||||
simpleline(buffer);
|
||||
}
|
||||
|
||||
/* Posix */
|
||||
#else
|
||||
|
||||
/*
|
||||
https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
*/
|
||||
|
||||
#include <termios.h>
|
||||
#include <unistd.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <ctype.h>
|
||||
#include <sys/stat.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <unistd.h>
|
||||
#include <string.h>
|
||||
#include <signal.h>
|
||||
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
"cons25",
|
||||
"dumb",
|
||||
"emacs",
|
||||
NULL
|
||||
};
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
return memcpy(mem, s, len);
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode() {
|
||||
struct termios t;
|
||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
||||
t.c_cflag |= (CS8);
|
||||
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
|
||||
t.c_cc[VMIN] = 1;
|
||||
t.c_cc[VTIME] = 0;
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
fatal:
|
||||
errno = ENOTTY;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode() {
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static int curpos() {
|
||||
char buf[32];
|
||||
int cols, rows;
|
||||
unsigned int i = 0;
|
||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
||||
while (i < sizeof(buf) - 1) {
|
||||
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
||||
if (buf[i] == 'R') break;
|
||||
i++;
|
||||
}
|
||||
buf[i] = '\0';
|
||||
if (buf[0] != 27 || buf[1] != '[') return -1;
|
||||
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
|
||||
return cols;
|
||||
}
|
||||
|
||||
static int getcols() {
|
||||
struct winsize ws;
|
||||
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
|
||||
int start, cols;
|
||||
start = curpos();
|
||||
if (start == -1) goto failed;
|
||||
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
|
||||
cols = curpos();
|
||||
if (cols == -1) goto failed;
|
||||
if (cols > start) {
|
||||
char seq[32];
|
||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
return cols;
|
||||
} else {
|
||||
return ws.ws_col;
|
||||
}
|
||||
failed:
|
||||
return 80;
|
||||
}
|
||||
|
||||
static void clear() {
|
||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
static void refresh() {
|
||||
char seq[64];
|
||||
JanetBuffer b;
|
||||
|
||||
/* Keep cursor position on screen */
|
||||
char *_buf = gbl_buf;
|
||||
int _len = gbl_len;
|
||||
int _pos = gbl_pos;
|
||||
while ((gbl_plen + _pos) >= gbl_cols) {
|
||||
_buf++;
|
||||
_len--;
|
||||
_pos--;
|
||||
}
|
||||
while ((gbl_plen + _len) > gbl_cols) {
|
||||
_len--;
|
||||
}
|
||||
|
||||
janet_buffer_init(&b, 0);
|
||||
/* Cursor to left edge, gbl_prompt and buffer */
|
||||
janet_buffer_push_u8(&b, '\r');
|
||||
janet_buffer_push_cstring(&b, gbl_prompt);
|
||||
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
||||
/* Erase to right */
|
||||
janet_buffer_push_cstring(&b, "\x1b[0K");
|
||||
/* Move cursor to original position. */
|
||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
||||
janet_buffer_push_cstring(&b, seq);
|
||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
janet_buffer_deinit(&b);
|
||||
}
|
||||
|
||||
static int insert(char c) {
|
||||
if (gbl_len < JANET_LINE_MAX - 1) {
|
||||
if (gbl_len == gbl_pos) {
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
if (gbl_plen + gbl_len < gbl_cols) {
|
||||
/* Avoid a full update of the line in the
|
||||
* trivial case. */
|
||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
||||
} else {
|
||||
refresh();
|
||||
}
|
||||
} else {
|
||||
memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void historymove(int delta) {
|
||||
if (gbl_history_count > 1) {
|
||||
free(gbl_history[gbl_historyi]);
|
||||
gbl_history[gbl_historyi] = sdup(gbl_buf);
|
||||
|
||||
gbl_historyi += delta;
|
||||
if (gbl_historyi < 0) {
|
||||
gbl_historyi = 0;
|
||||
return;
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
return;
|
||||
}
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void addhistory() {
|
||||
int i, len;
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
len = gbl_history_count;
|
||||
if (len < JANET_HISTORY_MAX) {
|
||||
gbl_history[gbl_history_count++] = newline;
|
||||
len++;
|
||||
} else {
|
||||
free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
}
|
||||
for (i = len - 1; i > 0; i--) {
|
||||
gbl_history[i] = gbl_history[i - 1];
|
||||
}
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
|
||||
static void replacehistory() {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
|
||||
static void kleft() {
|
||||
if (gbl_pos > 0) {
|
||||
gbl_pos--;
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kright() {
|
||||
if (gbl_pos != gbl_len) {
|
||||
gbl_pos++;
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspace() {
|
||||
if (gbl_pos > 0) {
|
||||
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_pos--;
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kdelete() {
|
||||
if (gbl_pos != gbl_len) {
|
||||
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static int line() {
|
||||
gbl_cols = getcols();
|
||||
gbl_plen = 0;
|
||||
gbl_len = 0;
|
||||
gbl_pos = 0;
|
||||
while (gbl_prompt[gbl_plen]) gbl_plen++;
|
||||
gbl_buf[0] = '\0';
|
||||
|
||||
addhistory();
|
||||
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
int nread;
|
||||
char seq[3];
|
||||
|
||||
nread = read(STDIN_FILENO, &c, 1);
|
||||
if (nread <= 0) return -1;
|
||||
|
||||
switch (c) {
|
||||
default:
|
||||
if (insert(c)) return -1;
|
||||
break;
|
||||
case 9: /* tab */
|
||||
if (insert(' ')) return -1;
|
||||
if (insert(' ')) return -1;
|
||||
break;
|
||||
case 13: /* enter */
|
||||
return 0;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
gbl_sigint_flag = 1;
|
||||
return -1;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace();
|
||||
break;
|
||||
case 4: /* ctrl-d, eof */
|
||||
return -1;
|
||||
case 2: /* ctrl-b */
|
||||
kleft();
|
||||
break;
|
||||
case 6: /* ctrl-f */
|
||||
kright();
|
||||
break;
|
||||
case 21:
|
||||
gbl_buf[0] = '\0';
|
||||
gbl_pos = gbl_len = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 26: /* ctrl-z */
|
||||
norawmode();
|
||||
kill(getpid(), SIGSTOP);
|
||||
rawmode();
|
||||
refresh();
|
||||
break;
|
||||
case 12:
|
||||
clear();
|
||||
refresh();
|
||||
break;
|
||||
case 27: /* escape sequence */
|
||||
/* Read the next two bytes representing the escape sequence.
|
||||
* Use two calls to handle slow terminals returning the two
|
||||
* chars at different times. */
|
||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (seq[0] == '[') {
|
||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||
/* Extended escape, read additional byte. */
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '3': /* delete */
|
||||
kdelete();
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
case 'A':
|
||||
historymove(1);
|
||||
break;
|
||||
case 'B':
|
||||
historymove(-1);
|
||||
break;
|
||||
case 'C': /* Right */
|
||||
kright();
|
||||
break;
|
||||
case 'D': /* Left */
|
||||
kleft();
|
||||
break;
|
||||
case 'H':
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F':
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (seq[0] == 'O') {
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
case 'H':
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F':
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_deinit() {
|
||||
int i;
|
||||
norawmode();
|
||||
for (i = 0; i < gbl_history_count; i++)
|
||||
free(gbl_history[i]);
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
const char *t = getenv("TERM");
|
||||
int i;
|
||||
if (!t) return 1;
|
||||
for (i = 0; badterms[i]; i++)
|
||||
if (!strcmp(t, badterms[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (rawmode()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
if (gbl_sigint_flag) {
|
||||
raise(SIGINT);
|
||||
} else {
|
||||
fputc('\n', out);
|
||||
}
|
||||
return;
|
||||
}
|
||||
fflush(stdin);
|
||||
norawmode();
|
||||
fputc('\n', out);
|
||||
janet_buffer_ensure(buffer, gbl_len + 1, 2);
|
||||
memcpy(buffer->data, gbl_buf, gbl_len);
|
||||
buffer->data[gbl_len] = '\n';
|
||||
buffer->count = gbl_len + 1;
|
||||
replacehistory();
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -1,86 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "line.h"
|
||||
#endif
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
return status;
|
||||
}
|
||||
881
src/mainclient/shell.c
Normal file
881
src/mainclient/shell.c
Normal file
@@ -0,0 +1,881 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#if !defined(_POSIX_C_SOURCE)
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
/*
|
||||
* Line Editing
|
||||
*/
|
||||
|
||||
static JANET_THREAD_LOCAL JanetTable *gbl_complete_env;
|
||||
|
||||
/* Common */
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 3);
|
||||
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
gbl_complete_env = (argc >= 3) ? janet_gettable(argv, 2) : NULL;
|
||||
janet_line_get(str, buf);
|
||||
gbl_complete_env = NULL;
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
buffer->count = 0;
|
||||
int c;
|
||||
for (;;) {
|
||||
c = fgetc(in);
|
||||
if (feof(in) || c < 0) {
|
||||
break;
|
||||
}
|
||||
janet_buffer_push_u8(buffer, (uint8_t) c);
|
||||
if (c == '\n') break;
|
||||
}
|
||||
}
|
||||
|
||||
/* Windows */
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_deinit() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
fputs(p, out);
|
||||
fflush(out);
|
||||
simpleline(buffer);
|
||||
}
|
||||
|
||||
/* Posix */
|
||||
#else
|
||||
|
||||
/*
|
||||
https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
*/
|
||||
|
||||
#include <termios.h>
|
||||
#include <unistd.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <ctype.h>
|
||||
#include <sys/stat.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <unistd.h>
|
||||
#include <string.h>
|
||||
#include <signal.h>
|
||||
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
"cons25",
|
||||
"dumb",
|
||||
"emacs",
|
||||
NULL
|
||||
};
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
return memcpy(mem, s, len);
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
struct termios t;
|
||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
||||
t.c_cflag |= (CS8);
|
||||
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
|
||||
t.c_cc[VMIN] = 1;
|
||||
t.c_cc[VTIME] = 0;
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
fatal:
|
||||
errno = ENOTTY;
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode(void) {
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static int curpos(void) {
|
||||
char buf[32];
|
||||
int cols, rows;
|
||||
unsigned int i = 0;
|
||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
||||
while (i < sizeof(buf) - 1) {
|
||||
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
||||
if (buf[i] == 'R') break;
|
||||
i++;
|
||||
}
|
||||
buf[i] = '\0';
|
||||
if (buf[0] != 27 || buf[1] != '[') return -1;
|
||||
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
|
||||
return cols;
|
||||
}
|
||||
|
||||
static int getcols(void) {
|
||||
struct winsize ws;
|
||||
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
|
||||
int start, cols;
|
||||
start = curpos();
|
||||
if (start == -1) goto failed;
|
||||
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
|
||||
cols = curpos();
|
||||
if (cols == -1) goto failed;
|
||||
if (cols > start) {
|
||||
char seq[32];
|
||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
return cols;
|
||||
} else {
|
||||
return ws.ws_col;
|
||||
}
|
||||
failed:
|
||||
return 80;
|
||||
}
|
||||
|
||||
static void clear(void) {
|
||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
static void refresh(void) {
|
||||
char seq[64];
|
||||
JanetBuffer b;
|
||||
|
||||
/* Keep cursor position on screen */
|
||||
char *_buf = gbl_buf;
|
||||
int _len = gbl_len;
|
||||
int _pos = gbl_pos;
|
||||
while ((gbl_plen + _pos) >= gbl_cols) {
|
||||
_buf++;
|
||||
_len--;
|
||||
_pos--;
|
||||
}
|
||||
while ((gbl_plen + _len) > gbl_cols) {
|
||||
_len--;
|
||||
}
|
||||
|
||||
janet_buffer_init(&b, 0);
|
||||
/* Cursor to left edge, gbl_prompt and buffer */
|
||||
janet_buffer_push_u8(&b, '\r');
|
||||
janet_buffer_push_cstring(&b, gbl_prompt);
|
||||
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
||||
/* Erase to right */
|
||||
janet_buffer_push_cstring(&b, "\x1b[0K");
|
||||
/* Move cursor to original position. */
|
||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
||||
janet_buffer_push_cstring(&b, seq);
|
||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
janet_buffer_deinit(&b);
|
||||
}
|
||||
|
||||
static void clearlines(void) {
|
||||
for (int i = 0; i < gbl_lines_below; i++) {
|
||||
fprintf(stderr, "\x1b[1B\x1b[999D\x1b[K");
|
||||
}
|
||||
if (gbl_lines_below) {
|
||||
fprintf(stderr, "\x1b[%dA\x1b[999D", gbl_lines_below);
|
||||
fflush(stderr);
|
||||
gbl_lines_below = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static int insert(char c, int draw) {
|
||||
if (gbl_len < JANET_LINE_MAX - 1) {
|
||||
if (gbl_len == gbl_pos) {
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
if (draw) {
|
||||
if (gbl_plen + gbl_len < gbl_cols) {
|
||||
/* Avoid a full update of the line in the
|
||||
* trivial case. */
|
||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
||||
} else {
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
} else {
|
||||
memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void historymove(int delta) {
|
||||
if (gbl_history_count > 1) {
|
||||
free(gbl_history[gbl_historyi]);
|
||||
gbl_history[gbl_historyi] = sdup(gbl_buf);
|
||||
|
||||
gbl_historyi += delta;
|
||||
if (gbl_historyi < 0) {
|
||||
gbl_historyi = 0;
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
}
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void addhistory(void) {
|
||||
int i, len;
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
len = gbl_history_count;
|
||||
if (len < JANET_HISTORY_MAX) {
|
||||
gbl_history[gbl_history_count++] = newline;
|
||||
len++;
|
||||
} else {
|
||||
free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
}
|
||||
for (i = len - 1; i > 0; i--) {
|
||||
gbl_history[i] = gbl_history[i - 1];
|
||||
}
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
|
||||
static void replacehistory(void) {
|
||||
/* History count is always > 0 here */
|
||||
if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
|
||||
/* Delete history */
|
||||
free(gbl_history[0]);
|
||||
for (int i = 1; i < gbl_history_count; i++) {
|
||||
gbl_history[i - 1] = gbl_history[i];
|
||||
}
|
||||
gbl_history_count--;
|
||||
} else {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
}
|
||||
|
||||
static void kleft(void) {
|
||||
if (gbl_pos > 0) {
|
||||
gbl_pos--;
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kleftw(void) {
|
||||
while (gbl_pos > 0 && isspace(gbl_buf[gbl_pos - 1])) {
|
||||
gbl_pos--;
|
||||
}
|
||||
while (gbl_pos > 0 && !isspace(gbl_buf[gbl_pos - 1])) {
|
||||
gbl_pos--;
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kright(void) {
|
||||
if (gbl_pos != gbl_len) {
|
||||
gbl_pos++;
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void krightw(void) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kbackspace(int draw) {
|
||||
if (gbl_pos > 0) {
|
||||
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_pos--;
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kdelete(int draw) {
|
||||
if (gbl_pos != gbl_len) {
|
||||
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspacew(void) {
|
||||
while (gbl_pos && isspace(gbl_buf[gbl_pos - 1])) {
|
||||
kbackspace(0);
|
||||
}
|
||||
while (gbl_pos && !isspace(gbl_buf[gbl_pos - 1])) {
|
||||
kbackspace(0);
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kdeletew(void) {
|
||||
while (gbl_pos < gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
kdelete(0);
|
||||
}
|
||||
while (gbl_pos < gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
kdelete(0);
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
|
||||
/* See tools/symchargen.c */
|
||||
static int is_symbol_char_gen(uint8_t c) {
|
||||
if (c & 0x80) return 1;
|
||||
if (c >= 'a' && c <= 'z') return 1;
|
||||
if (c >= 'A' && c <= 'Z') return 1;
|
||||
if (c >= '0' && c <= '9') return 1;
|
||||
return (c == '!' ||
|
||||
c == '$' ||
|
||||
c == '%' ||
|
||||
c == '&' ||
|
||||
c == '*' ||
|
||||
c == '+' ||
|
||||
c == '-' ||
|
||||
c == '.' ||
|
||||
c == '/' ||
|
||||
c == ':' ||
|
||||
c == '<' ||
|
||||
c == '?' ||
|
||||
c == '=' ||
|
||||
c == '>' ||
|
||||
c == '@' ||
|
||||
c == '^' ||
|
||||
c == '_');
|
||||
}
|
||||
|
||||
static JanetByteView get_symprefix(void) {
|
||||
/* Calculate current partial symbol. Maybe we could actually hook up the Janet
|
||||
* parser here...*/
|
||||
int i;
|
||||
JanetByteView ret;
|
||||
ret.len = 0;
|
||||
for (i = gbl_pos - 1; i >= 0; i--) {
|
||||
uint8_t c = (uint8_t) gbl_buf[i];
|
||||
if (!is_symbol_char_gen(c)) break;
|
||||
ret.len++;
|
||||
}
|
||||
/* Will be const for duration of match checking */
|
||||
ret.bytes = (const uint8_t *)(gbl_buf + i + 1);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int compare_bytes(JanetByteView a, JanetByteView b) {
|
||||
int32_t minlen = a.len < b.len ? a.len : b.len;
|
||||
int result = strncmp((const char *) a.bytes, (const char *) b.bytes, minlen);
|
||||
if (result) return result;
|
||||
return a.len < b.len ? -1 : a.len > b.len ? 1 : 0;
|
||||
}
|
||||
|
||||
static void check_match(JanetByteView src, const uint8_t *testsym, int32_t testlen) {
|
||||
JanetByteView test;
|
||||
test.bytes = testsym;
|
||||
test.len = testlen;
|
||||
if (src.len > test.len || strncmp((const char *) src.bytes, (const char *) test.bytes, src.len)) return;
|
||||
JanetByteView mm = test;
|
||||
for (int i = 0; i < gbl_match_count; i++) {
|
||||
if (compare_bytes(mm, gbl_matches[i]) < 0) {
|
||||
JanetByteView temp = mm;
|
||||
mm = gbl_matches[i];
|
||||
gbl_matches[i] = temp;
|
||||
}
|
||||
}
|
||||
if (gbl_match_count == JANET_MATCH_MAX) return;
|
||||
gbl_matches[gbl_match_count++] = mm;
|
||||
}
|
||||
|
||||
static void check_cmatch(JanetByteView src, const char *cstr) {
|
||||
check_match(src, (const uint8_t *) cstr, (int32_t) strlen(cstr));
|
||||
}
|
||||
|
||||
static JanetByteView longest_common_prefix(void) {
|
||||
JanetByteView bv;
|
||||
if (gbl_match_count == 0) {
|
||||
bv.len = 0;
|
||||
bv.bytes = NULL;
|
||||
} else {
|
||||
bv = gbl_matches[0];
|
||||
for (int i = 0; i < gbl_match_count; i++) {
|
||||
JanetByteView other = gbl_matches[i];
|
||||
int32_t minlen = other.len < bv.len ? other.len : bv.len;
|
||||
for (bv.len = 0; bv.len < minlen; bv.len++) {
|
||||
if (bv.bytes[bv.len] != other.bytes[bv.len]) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return bv;
|
||||
}
|
||||
|
||||
static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "break");
|
||||
check_cmatch(src, "def");
|
||||
check_cmatch(src, "do");
|
||||
check_cmatch(src, "fn");
|
||||
check_cmatch(src, "if");
|
||||
check_cmatch(src, "quasiquote");
|
||||
check_cmatch(src, "quote");
|
||||
check_cmatch(src, "set");
|
||||
check_cmatch(src, "splice");
|
||||
check_cmatch(src, "unquote");
|
||||
check_cmatch(src, "var");
|
||||
check_cmatch(src, "while");
|
||||
}
|
||||
|
||||
static void kshowcomp(void) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
if (env == NULL) {
|
||||
insert(' ', 0);
|
||||
insert(' ', 0);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Advance while on symbol char */
|
||||
while (is_symbol_char_gen(gbl_buf[gbl_pos]))
|
||||
gbl_pos++;
|
||||
|
||||
JanetByteView prefix = get_symprefix();
|
||||
if (prefix.len == 0) return;
|
||||
|
||||
/* Find all matches */
|
||||
gbl_match_count = 0;
|
||||
while (NULL != env) {
|
||||
JanetKV *kvend = env->data + env->capacity;
|
||||
for (JanetKV *kv = env->data; kv < kvend; kv++) {
|
||||
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
|
||||
const uint8_t *sym = janet_unwrap_symbol(kv->key);
|
||||
check_match(prefix, sym, janet_string_length(sym));
|
||||
}
|
||||
env = env->proto;
|
||||
}
|
||||
|
||||
check_specials(prefix);
|
||||
|
||||
JanetByteView lcp = longest_common_prefix();
|
||||
for (int i = prefix.len; i < lcp.len; i++) {
|
||||
insert(lcp.bytes[i], 0);
|
||||
}
|
||||
|
||||
if (!gbl_lines_below && prefix.len != lcp.len) return;
|
||||
|
||||
int32_t maxlen = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++)
|
||||
if (gbl_matches[i].len > maxlen)
|
||||
maxlen = gbl_matches[i].len;
|
||||
|
||||
int num_cols = getcols();
|
||||
clearlines();
|
||||
if (gbl_match_count >= 2) {
|
||||
|
||||
/* Second pass, print */
|
||||
int col_width = maxlen + 4;
|
||||
int cols = num_cols / col_width;
|
||||
if (cols == 0) cols = 1;
|
||||
int current_col = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++) {
|
||||
if (current_col == 0) {
|
||||
putc('\n', stderr);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
JanetByteView s = gbl_matches[i];
|
||||
fprintf(stderr, "%s", (const char *) s.bytes);
|
||||
for (int j = s.len; j < col_width; j++) {
|
||||
putc(' ', stderr);
|
||||
}
|
||||
current_col = (current_col + 1) % cols;
|
||||
}
|
||||
|
||||
/* Go up to original line (zsh-like autocompletion) */
|
||||
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
|
||||
|
||||
fflush(stderr);
|
||||
}
|
||||
}
|
||||
|
||||
static int line() {
|
||||
gbl_cols = getcols();
|
||||
gbl_plen = 0;
|
||||
gbl_len = 0;
|
||||
gbl_pos = 0;
|
||||
while (gbl_prompt[gbl_plen]) gbl_plen++;
|
||||
gbl_buf[0] = '\0';
|
||||
|
||||
addhistory();
|
||||
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
char seq[3];
|
||||
|
||||
if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
|
||||
|
||||
switch (c) {
|
||||
default:
|
||||
if (c < 0x20) break;
|
||||
if (insert(c, 1)) return -1;
|
||||
break;
|
||||
case 1: /* ctrl-a */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 2: /* ctrl-b */
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
gbl_sigint_flag = 1;
|
||||
clearlines();
|
||||
return -1;
|
||||
case 4: /* ctrl-d, eof */
|
||||
clearlines();
|
||||
return -1;
|
||||
case 5: /* ctrl-e */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
case 6: /* ctrl-f */
|
||||
kright();
|
||||
break;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace(1);
|
||||
break;
|
||||
case 9: /* tab */
|
||||
kshowcomp();
|
||||
refresh();
|
||||
break;
|
||||
case 11: /* ctrl-k */
|
||||
gbl_buf[gbl_pos] = '\0';
|
||||
gbl_len = gbl_pos;
|
||||
refresh();
|
||||
break;
|
||||
case 12: /* ctrl-l */
|
||||
clear();
|
||||
refresh();
|
||||
break;
|
||||
case 13: /* enter */
|
||||
clearlines();
|
||||
return 0;
|
||||
case 14: /* ctrl-n */
|
||||
historymove(-1);
|
||||
break;
|
||||
case 16: /* ctrl-p */
|
||||
historymove(1);
|
||||
break;
|
||||
case 21: { /* ctrl-u */
|
||||
memmove(gbl_buf, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_len -= gbl_pos;
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
case 23: /* ctrl-w */
|
||||
kbackspacew();
|
||||
break;
|
||||
case 26: /* ctrl-z */
|
||||
norawmode();
|
||||
kill(getpid(), SIGSTOP);
|
||||
rawmode();
|
||||
refresh();
|
||||
break;
|
||||
case 27: /* escape sequence */
|
||||
/* Read the next two bytes representing the escape sequence.
|
||||
* Use two calls to handle slow terminals returning the two
|
||||
* chars at different times. */
|
||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||
/* Esc[ = Control Sequence Introducer (CSI) */
|
||||
if (seq[0] == '[') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||
/* Extended escape, read additional byte. */
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '1': /* Home */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case '3': /* delete */
|
||||
kdelete(1);
|
||||
break;
|
||||
case '4': /* End */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (seq[0] == 'O') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
case 'H': /* Home (some keyboards) */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F': /* End (some keyboards) */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
switch (seq[1]) {
|
||||
/* Single escape sequences */
|
||||
default:
|
||||
break;
|
||||
case 'A': /* Up */
|
||||
historymove(1);
|
||||
break;
|
||||
case 'B': /* Down */
|
||||
historymove(-1);
|
||||
break;
|
||||
case 'C': /* Right */
|
||||
kright();
|
||||
break;
|
||||
case 'D': /* Left */
|
||||
kleft();
|
||||
break;
|
||||
case 'H': /* Home */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F': /* End */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/* Check alt-(shift) bindings */
|
||||
switch (seq[0]) {
|
||||
default:
|
||||
break;
|
||||
case 'd': /* Alt-d */
|
||||
kdeletew();
|
||||
break;
|
||||
case 'b': /* Alt-b */
|
||||
kleftw();
|
||||
break;
|
||||
case 'f': /* Alt-f */
|
||||
krightw();
|
||||
break;
|
||||
case ',': /* Alt-, */
|
||||
historymove(JANET_HISTORY_MAX);
|
||||
break;
|
||||
case '.': /* Alt-. */
|
||||
historymove(-JANET_HISTORY_MAX);
|
||||
break;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_deinit() {
|
||||
int i;
|
||||
norawmode();
|
||||
for (i = 0; i < gbl_history_count; i++)
|
||||
free(gbl_history[i]);
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
const char *t = getenv("TERM");
|
||||
int i;
|
||||
if (!t) return 1;
|
||||
for (i = 0; badterms[i]; i++)
|
||||
if (!strcmp(t, badterms[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (rawmode()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
if (gbl_sigint_flag) {
|
||||
raise(SIGINT);
|
||||
} else {
|
||||
fputc('\n', out);
|
||||
}
|
||||
return;
|
||||
}
|
||||
fflush(stdin);
|
||||
norawmode();
|
||||
fputc('\n', out);
|
||||
janet_buffer_ensure(buffer, gbl_len + 1, 2);
|
||||
memcpy(buffer->data, gbl_buf, gbl_len);
|
||||
buffer->data[gbl_len] = '\n';
|
||||
buffer->count = gbl_len + 1;
|
||||
replacehistory();
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Entry
|
||||
*/
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
return status;
|
||||
}
|
||||
@@ -1,126 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <janet.h>
|
||||
#include <emscripten.h>
|
||||
|
||||
extern const unsigned char *janet_gen_webinit;
|
||||
extern int32_t janet_gen_webinit_size;
|
||||
|
||||
static JanetFiber *repl_fiber = NULL;
|
||||
static JanetBuffer *line_buffer = NULL;
|
||||
static const uint8_t *line_prompt = NULL;
|
||||
|
||||
/* Yield to JS event loop from janet. Takes a repl prompt
|
||||
* and a buffer to fill with input data. */
|
||||
static Janet repl_yield(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
line_prompt = janet_getstring(argv, 0);
|
||||
line_buffer = janet_getbuffer(argv, 1);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Re-enter the loop */
|
||||
static int enter_loop(void) {
|
||||
Janet ret;
|
||||
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
|
||||
if (status == JANET_SIGNAL_ERROR) {
|
||||
janet_stacktrace(repl_fiber, ret);
|
||||
janet_deinit();
|
||||
repl_fiber = NULL;
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Allow JS interoperation from within janet */
|
||||
static Janet cfun_js(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
emscripten_run_script((const char *)bytes.bytes);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Initialize the repl */
|
||||
EMSCRIPTEN_KEEPALIVE
|
||||
void repl_init(void) {
|
||||
int status;
|
||||
JanetTable *env;
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
janet_register("repl-yield", repl_yield);
|
||||
janet_register("js", cfun_js);
|
||||
env = janet_core_env(NULL);
|
||||
|
||||
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
||||
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
||||
|
||||
/* Run startup script */
|
||||
Janet ret;
|
||||
status = janet_dobytes(env, janet_gen_webinit, janet_gen_webinit_size, "webinit.janet", &ret);
|
||||
if (status == JANET_SIGNAL_ERROR) {
|
||||
printf("start up error.\n");
|
||||
janet_deinit();
|
||||
repl_fiber = NULL;
|
||||
return;
|
||||
}
|
||||
janet_gcroot(ret);
|
||||
repl_fiber = janet_unwrap_fiber(ret);
|
||||
|
||||
/* Start repl */
|
||||
if (enter_loop()) return;
|
||||
}
|
||||
|
||||
/* Deinitialize the repl */
|
||||
EMSCRIPTEN_KEEPALIVE
|
||||
void repl_deinit(void) {
|
||||
if (!repl_fiber) {
|
||||
return;
|
||||
}
|
||||
repl_fiber = NULL;
|
||||
line_buffer = NULL;
|
||||
janet_deinit();
|
||||
}
|
||||
|
||||
/* Get the prompt to show in the repl */
|
||||
EMSCRIPTEN_KEEPALIVE
|
||||
const char *repl_prompt(void) {
|
||||
return line_prompt ? ((const char *)line_prompt) : "";
|
||||
}
|
||||
|
||||
/* Restart the repl calling from JS. Pass in the input for the next line. */
|
||||
EMSCRIPTEN_KEEPALIVE
|
||||
void repl_input(char *input) {
|
||||
|
||||
/* Create the repl if we haven't yet */
|
||||
if (!repl_fiber) {
|
||||
printf("initialize the repl first");
|
||||
}
|
||||
|
||||
/* Now fill the pending line_buffer and resume the repl loop */
|
||||
if (line_buffer) {
|
||||
janet_buffer_push_cstring(line_buffer, input);
|
||||
line_buffer = NULL;
|
||||
enter_loop();
|
||||
}
|
||||
}
|
||||
@@ -1,12 +0,0 @@
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
|
||||
(fiber/new (fn webrepl []
|
||||
(setdyn :pretty-format "%.20P")
|
||||
(repl (fn get-line [buf p]
|
||||
(def [offset] (parser/where p))
|
||||
(def prompt (string "janet:" offset ":" (parser/state p :delimiters) "> "))
|
||||
(repl-yield prompt buf)
|
||||
(yield)
|
||||
buf))))
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -4,22 +4,25 @@
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
(var start-time 0)
|
||||
|
||||
(defn assert [x e]
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
(defn assert
|
||||
"Override's the default assert with some nice error handling."
|
||||
[x e]
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
@@ -32,10 +35,12 @@
|
||||
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
(set suite-num x)
|
||||
(set start-time (os/clock))
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
(defn end-suite []
|
||||
(print "\n\nTest suite " suite-num " finished.")
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
(def delta (- (os/clock) start-time))
|
||||
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
|
||||
@@ -5,6 +5,10 @@
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
:entry "testexec.janet")
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
(use build/testmod)
|
||||
(use build/testmod2)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (get5)))
|
||||
(print (+ (get5) (get6))))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose and contributors
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
40
test/install/testmod2.c
Normal file
40
test/install/testmod2.c
Normal file
@@ -0,0 +1,40 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
static Janet cfun_get_six(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(6.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get6", cfun_get_six, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,18 +37,18 @@
|
||||
(assert (= 7 (% 20 13)) "modulo 1")
|
||||
(assert (= -7 (% -20 13)) "modulo 2")
|
||||
|
||||
(assert (order< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "type ordering")
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "type ordering")
|
||||
|
||||
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
|
||||
(assert (= (get {} 1) nil) "get nil from empty struct")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -232,11 +232,11 @@
|
||||
(assert (= 4 ((get closures 4))) "closure in loop 4")
|
||||
|
||||
# More numerical tests
|
||||
(assert (== 1 1.0) "numerical equal 1")
|
||||
(assert (== 0 0.0) "numerical equal 2")
|
||||
(assert (== 0 -0.0) "numerical equal 3")
|
||||
(assert (== 2_147_483_647 2_147_483_647.0) "numerical equal 4")
|
||||
(assert (== -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
|
||||
(assert (= 1 1.0) "numerical equal 1")
|
||||
(assert (= 0 0.0) "numerical equal 2")
|
||||
(assert (= 0 -0.0) "numerical equal 3")
|
||||
(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
|
||||
(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
|
||||
|
||||
# Array tests
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
#' Copyright (c) 2019 Calvin Rose
|
||||
#' Copyright (c) 2020 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -203,12 +203,12 @@
|
||||
(defn check-match
|
||||
[pat text should-match]
|
||||
(def result (peg/match pat text))
|
||||
(assert (= (not should-match) (not result)) text))
|
||||
(assert (= (not should-match) (not result)) (string "check-match " text)))
|
||||
|
||||
(defn check-deep
|
||||
[pat text what]
|
||||
(def result (peg/match pat text))
|
||||
(assert (deep= result what) text))
|
||||
(assert (deep= result what) (string "check-deep " text)))
|
||||
|
||||
# Just numbers
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose & contributors
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose & contributors
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -62,8 +62,8 @@
|
||||
# just to big
|
||||
(def d (u64 "123456789123456789123456789"))))
|
||||
|
||||
(assert (:== (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) "0xfffffffffffffff") "bigint operations")
|
||||
(assert (let [a (u64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations")
|
||||
(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff")) "bigint operations 1")
|
||||
(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2))) "bigint operations 2")
|
||||
|
||||
(assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
|
||||
(assert (= (string (u64 123)) "123") "u64 prints reasonably")
|
||||
@@ -72,9 +72,6 @@
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# in place operators
|
||||
(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:== a 10002065535)) "in place operators")
|
||||
|
||||
# int64 typed arrays
|
||||
(assert (let [t (tarray/new :int64 10)
|
||||
b (i64 1000)]
|
||||
@@ -84,10 +81,10 @@
|
||||
(set (t 3) (t 0))
|
||||
(set (t 4) (u64 1000))
|
||||
(and
|
||||
(:== (t 0) (t 1))
|
||||
(:== (t 1) (t 2))
|
||||
(:== (t 2) (t 3))
|
||||
(:== (t 3) (t 4))
|
||||
(= (t 0) (t 1))
|
||||
(= (t 1) (t 2))
|
||||
(= (t 2) (t 3))
|
||||
(= (t 3) (t 4))
|
||||
))
|
||||
"int64 typed arrays")
|
||||
|
||||
@@ -167,6 +164,11 @@
|
||||
(defn test-expand [path temp]
|
||||
(string (module/expand-path path temp)))
|
||||
|
||||
# Right hand operators
|
||||
(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
|
||||
(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
|
||||
(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
|
||||
|
||||
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
|
||||
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2019 Calvin Rose & contributors
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -277,4 +277,26 @@
|
||||
|
||||
(assert (= (constantly) (constantly)) "comptime 1")
|
||||
|
||||
(assert-error "arity issue in macro" (eval '(each [])))
|
||||
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
|
||||
|
||||
(with [f (file/temp)]
|
||||
(file/write f "foo\n")
|
||||
(file/flush f)
|
||||
(file/seek f :set 0)
|
||||
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
|
||||
|
||||
(var counter 0)
|
||||
(when-with [x nil |$]
|
||||
(++ counter))
|
||||
(when-with [x 10 |$]
|
||||
(+= counter 10))
|
||||
|
||||
(assert (= 10 counter) "when-with 1")
|
||||
|
||||
(if-with [x nil |$] (++ counter) (+= counter 10))
|
||||
(if-with [x true |$] (+= counter 20) (+= counter 30))
|
||||
|
||||
(assert (= 40 counter) "if-with 1")
|
||||
|
||||
(end-suite)
|
||||
|
||||
BIN
tools/EnVar.dll
Normal file
BIN
tools/EnVar.dll
Normal file
Binary file not shown.
@@ -1,327 +0,0 @@
|
||||
/**
|
||||
* EnvVarUpdate.nsh
|
||||
* : Environmental Variables: append, prepend, and remove entries
|
||||
*
|
||||
* WARNING: If you use StrFunc.nsh header then include it before this file
|
||||
* with all required definitions. This is to avoid conflicts
|
||||
*
|
||||
* Usage:
|
||||
* ${EnvVarUpdate} "ResultVar" "EnvVarName" "Action" "RegLoc" "PathString"
|
||||
*
|
||||
* Credits:
|
||||
* Version 1.0
|
||||
* * Cal Turney (turnec2)
|
||||
* * Amir Szekely (KiCHiK) and e-circ for developing the forerunners of this
|
||||
* function: AddToPath, un.RemoveFromPath, AddToEnvVar, un.RemoveFromEnvVar,
|
||||
* WriteEnvStr, and un.DeleteEnvStr
|
||||
* * Diego Pedroso (deguix) for StrTok
|
||||
* * Kevin English (kenglish_hi) for StrContains
|
||||
* * Hendri Adriaens (Smile2Me), Diego Pedroso (deguix), and Dan Fuhry
|
||||
* (dandaman32) for StrReplace
|
||||
*
|
||||
* Version 1.1 (compatibility with StrFunc.nsh)
|
||||
* * techtonik
|
||||
*
|
||||
* http://nsis.sourceforge.net/Environmental_Variables:_append%2C_prepend%2C_and_remove_entries
|
||||
*
|
||||
*/
|
||||
|
||||
|
||||
!ifndef ENVVARUPDATE_FUNCTION
|
||||
!define ENVVARUPDATE_FUNCTION
|
||||
!verbose push
|
||||
!verbose 3
|
||||
!include "LogicLib.nsh"
|
||||
!include "WinMessages.NSH"
|
||||
!include "StrFunc.nsh"
|
||||
|
||||
; ---- Fix for conflict if StrFunc.nsh is already includes in main file -----------------------
|
||||
!macro _IncludeStrFunction StrFuncName
|
||||
!ifndef ${StrFuncName}_INCLUDED
|
||||
${${StrFuncName}}
|
||||
!endif
|
||||
!ifndef Un${StrFuncName}_INCLUDED
|
||||
${Un${StrFuncName}}
|
||||
!endif
|
||||
!define un.${StrFuncName} "${Un${StrFuncName}}"
|
||||
!macroend
|
||||
|
||||
!insertmacro _IncludeStrFunction StrTok
|
||||
!insertmacro _IncludeStrFunction StrStr
|
||||
!insertmacro _IncludeStrFunction StrRep
|
||||
|
||||
; ---------------------------------- Macro Definitions ----------------------------------------
|
||||
!macro _EnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
|
||||
Push "${EnvVarName}"
|
||||
Push "${Action}"
|
||||
Push "${RegLoc}"
|
||||
Push "${PathString}"
|
||||
Call EnvVarUpdate
|
||||
Pop "${ResultVar}"
|
||||
!macroend
|
||||
!define EnvVarUpdate '!insertmacro "_EnvVarUpdateConstructor"'
|
||||
|
||||
!macro _unEnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
|
||||
Push "${EnvVarName}"
|
||||
Push "${Action}"
|
||||
Push "${RegLoc}"
|
||||
Push "${PathString}"
|
||||
Call un.EnvVarUpdate
|
||||
Pop "${ResultVar}"
|
||||
!macroend
|
||||
!define un.EnvVarUpdate '!insertmacro "_unEnvVarUpdateConstructor"'
|
||||
; ---------------------------------- Macro Definitions end-------------------------------------
|
||||
|
||||
;----------------------------------- EnvVarUpdate start----------------------------------------
|
||||
!define hklm_all_users 'HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"'
|
||||
!define hkcu_current_user 'HKCU "Environment"'
|
||||
|
||||
!macro EnvVarUpdate UN
|
||||
|
||||
Function ${UN}EnvVarUpdate
|
||||
|
||||
Push $0
|
||||
Exch 4
|
||||
Exch $1
|
||||
Exch 3
|
||||
Exch $2
|
||||
Exch 2
|
||||
Exch $3
|
||||
Exch
|
||||
Exch $4
|
||||
Push $5
|
||||
Push $6
|
||||
Push $7
|
||||
Push $8
|
||||
Push $9
|
||||
Push $R0
|
||||
|
||||
/* After this point:
|
||||
-------------------------
|
||||
$0 = ResultVar (returned)
|
||||
$1 = EnvVarName (input)
|
||||
$2 = Action (input)
|
||||
$3 = RegLoc (input)
|
||||
$4 = PathString (input)
|
||||
$5 = Orig EnvVar (read from registry)
|
||||
$6 = Len of $0 (temp)
|
||||
$7 = tempstr1 (temp)
|
||||
$8 = Entry counter (temp)
|
||||
$9 = tempstr2 (temp)
|
||||
$R0 = tempChar (temp) */
|
||||
|
||||
; Step 1: Read contents of EnvVarName from RegLoc
|
||||
;
|
||||
; Check for empty EnvVarName
|
||||
${If} $1 == ""
|
||||
SetErrors
|
||||
DetailPrint "ERROR: EnvVarName is blank"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Check for valid Action
|
||||
${If} $2 != "A"
|
||||
${AndIf} $2 != "P"
|
||||
${AndIf} $2 != "R"
|
||||
SetErrors
|
||||
DetailPrint "ERROR: Invalid Action - must be A, P, or R"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
${If} $3 == HKLM
|
||||
ReadRegStr $5 ${hklm_all_users} $1 ; Get EnvVarName from all users into $5
|
||||
${ElseIf} $3 == HKCU
|
||||
ReadRegStr $5 ${hkcu_current_user} $1 ; Read EnvVarName from current user into $5
|
||||
${Else}
|
||||
SetErrors
|
||||
DetailPrint 'ERROR: Action is [$3] but must be "HKLM" or HKCU"'
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Check for empty PathString
|
||||
${If} $4 == ""
|
||||
SetErrors
|
||||
DetailPrint "ERROR: PathString is blank"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Make sure we've got some work to do
|
||||
${If} $5 == ""
|
||||
${AndIf} $2 == "R"
|
||||
SetErrors
|
||||
DetailPrint "$1 is empty - Nothing to remove"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Step 2: Scrub EnvVar
|
||||
;
|
||||
StrCpy $0 $5 ; Copy the contents to $0
|
||||
; Remove spaces around semicolons (NOTE: spaces before the 1st entry or
|
||||
; after the last one are not removed here but instead in Step 3)
|
||||
${If} $0 != "" ; If EnvVar is not empty ...
|
||||
${Do}
|
||||
${${UN}StrStr} $7 $0 " ;"
|
||||
${If} $7 == ""
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
${${UN}StrRep} $0 $0 " ;" ";" ; Remove '<space>;'
|
||||
${Loop}
|
||||
${Do}
|
||||
${${UN}StrStr} $7 $0 "; "
|
||||
${If} $7 == ""
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
${${UN}StrRep} $0 $0 "; " ";" ; Remove ';<space>'
|
||||
${Loop}
|
||||
${Do}
|
||||
${${UN}StrStr} $7 $0 ";;"
|
||||
${If} $7 == ""
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
${${UN}StrRep} $0 $0 ";;" ";"
|
||||
${Loop}
|
||||
|
||||
; Remove a leading or trailing semicolon from EnvVar
|
||||
StrCpy $7 $0 1 0
|
||||
${If} $7 == ";"
|
||||
StrCpy $0 $0 "" 1 ; Change ';<EnvVar>' to '<EnvVar>'
|
||||
${EndIf}
|
||||
StrLen $6 $0
|
||||
IntOp $6 $6 - 1
|
||||
StrCpy $7 $0 1 $6
|
||||
${If} $7 == ";"
|
||||
StrCpy $0 $0 $6 ; Change ';<EnvVar>' to '<EnvVar>'
|
||||
${EndIf}
|
||||
; DetailPrint "Scrubbed $1: [$0]" ; Uncomment to debug
|
||||
${EndIf}
|
||||
|
||||
/* Step 3. Remove all instances of the target path/string (even if "A" or "P")
|
||||
$6 = bool flag (1 = found and removed PathString)
|
||||
$7 = a string (e.g. path) delimited by semicolon(s)
|
||||
$8 = entry counter starting at 0
|
||||
$9 = copy of $0
|
||||
$R0 = tempChar */
|
||||
|
||||
${If} $5 != "" ; If EnvVar is not empty ...
|
||||
StrCpy $9 $0
|
||||
StrCpy $0 ""
|
||||
StrCpy $8 0
|
||||
StrCpy $6 0
|
||||
|
||||
${Do}
|
||||
${${UN}StrTok} $7 $9 ";" $8 "0" ; $7 = next entry, $8 = entry counter
|
||||
|
||||
${If} $7 == "" ; If we've run out of entries,
|
||||
${ExitDo} ; were done
|
||||
${EndIf} ;
|
||||
|
||||
; Remove leading and trailing spaces from this entry (critical step for Action=Remove)
|
||||
${Do}
|
||||
StrCpy $R0 $7 1
|
||||
${If} $R0 != " "
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
StrCpy $7 $7 "" 1 ; Remove leading space
|
||||
${Loop}
|
||||
${Do}
|
||||
StrCpy $R0 $7 1 -1
|
||||
${If} $R0 != " "
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
StrCpy $7 $7 -1 ; Remove trailing space
|
||||
${Loop}
|
||||
${If} $7 == $4 ; If string matches, remove it by not appending it
|
||||
StrCpy $6 1 ; Set 'found' flag
|
||||
${ElseIf} $7 != $4 ; If string does NOT match
|
||||
${AndIf} $0 == "" ; and the 1st string being added to $0,
|
||||
StrCpy $0 $7 ; copy it to $0 without a prepended semicolon
|
||||
${ElseIf} $7 != $4 ; If string does NOT match
|
||||
${AndIf} $0 != "" ; and this is NOT the 1st string to be added to $0,
|
||||
StrCpy $0 $0;$7 ; append path to $0 with a prepended semicolon
|
||||
${EndIf} ;
|
||||
|
||||
IntOp $8 $8 + 1 ; Bump counter
|
||||
${Loop} ; Check for duplicates until we run out of paths
|
||||
${EndIf}
|
||||
|
||||
; Step 4: Perform the requested Action
|
||||
;
|
||||
${If} $2 != "R" ; If Append or Prepend
|
||||
${If} $6 == 1 ; And if we found the target
|
||||
DetailPrint "Target is already present in $1. It will be removed and"
|
||||
${EndIf}
|
||||
${If} $0 == "" ; If EnvVar is (now) empty
|
||||
StrCpy $0 $4 ; just copy PathString to EnvVar
|
||||
${If} $6 == 0 ; If found flag is either 0
|
||||
${OrIf} $6 == "" ; or blank (if EnvVarName is empty)
|
||||
DetailPrint "$1 was empty and has been updated with the target"
|
||||
${EndIf}
|
||||
${ElseIf} $2 == "A" ; If Append (and EnvVar is not empty),
|
||||
StrCpy $0 $0;$4 ; append PathString
|
||||
${If} $6 == 1
|
||||
DetailPrint "appended to $1"
|
||||
${Else}
|
||||
DetailPrint "Target was appended to $1"
|
||||
${EndIf}
|
||||
${Else} ; If Prepend (and EnvVar is not empty),
|
||||
StrCpy $0 $4;$0 ; prepend PathString
|
||||
${If} $6 == 1
|
||||
DetailPrint "prepended to $1"
|
||||
${Else}
|
||||
DetailPrint "Target was prepended to $1"
|
||||
${EndIf}
|
||||
${EndIf}
|
||||
${Else} ; If Action = Remove
|
||||
${If} $6 == 1 ; and we found the target
|
||||
DetailPrint "Target was found and removed from $1"
|
||||
${Else}
|
||||
DetailPrint "Target was NOT found in $1 (nothing to remove)"
|
||||
${EndIf}
|
||||
${If} $0 == ""
|
||||
DetailPrint "$1 is now empty"
|
||||
${EndIf}
|
||||
${EndIf}
|
||||
|
||||
; Step 5: Update the registry at RegLoc with the updated EnvVar and announce the change
|
||||
;
|
||||
ClearErrors
|
||||
${If} $3 == HKLM
|
||||
WriteRegExpandStr ${hklm_all_users} $1 $0 ; Write it in all users section
|
||||
${ElseIf} $3 == HKCU
|
||||
WriteRegExpandStr ${hkcu_current_user} $1 $0 ; Write it to current user section
|
||||
${EndIf}
|
||||
|
||||
IfErrors 0 +4
|
||||
MessageBox MB_OK|MB_ICONEXCLAMATION "Could not write updated $1 to $3"
|
||||
DetailPrint "Could not write updated $1 to $3"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
|
||||
; "Export" our change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
EnvVarUpdate_Restore_Vars:
|
||||
;
|
||||
; Restore the user's variables and return ResultVar
|
||||
Pop $R0
|
||||
Pop $9
|
||||
Pop $8
|
||||
Pop $7
|
||||
Pop $6
|
||||
Pop $5
|
||||
Pop $4
|
||||
Pop $3
|
||||
Pop $2
|
||||
Pop $1
|
||||
Push $0 ; Push my $0 (ResultVar)
|
||||
Exch
|
||||
Pop $0 ; Restore his $0
|
||||
|
||||
FunctionEnd
|
||||
|
||||
!macroend ; EnvVarUpdate UN
|
||||
!insertmacro EnvVarUpdate ""
|
||||
!insertmacro EnvVarUpdate "un."
|
||||
;----------------------------------- EnvVarUpdate end----------------------------------------
|
||||
|
||||
!verbose pop
|
||||
!endif
|
||||
@@ -5,6 +5,7 @@
|
||||
(print "/* Generated from janet version " janet/version "-" janet/build " */")
|
||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||
(print ```#define JANET_AMALG```)
|
||||
(print ```#define _POSIX_C_SOURCE 200112L```)
|
||||
(print ```#include "janet.h"```)
|
||||
|
||||
# Body
|
||||
|
||||
Binary file not shown.
BIN
tools/nsis-3.05-strlen_8192.zip
Normal file
BIN
tools/nsis-3.05-strlen_8192.zip
Normal file
Binary file not shown.
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
104
tools/xxd.c
104
tools/xxd.c
@@ -1,104 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Simple clone of the xxd tool used at build time. Used to
|
||||
* create headers out of source files. Only used for core libraries
|
||||
* like the bootstrapping code and the stl. */
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
|
||||
#define BUFSIZE 1024
|
||||
#define PERLINE 10
|
||||
|
||||
int main(int argc, const char **argv) {
|
||||
|
||||
static const char hex[] = "0123456789ABCDEF";
|
||||
char buf[BUFSIZE];
|
||||
size_t bytesRead = 0;
|
||||
int32_t totalRead = 0;
|
||||
int lineIndex = 0;
|
||||
int line = 0;
|
||||
|
||||
if (argc != 4) {
|
||||
fprintf(stderr, "Usage: %s infile outfile symbol\n", argv[0]);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Open the files */
|
||||
FILE *in = fopen(argv[1], "rb");
|
||||
FILE *out = fopen(argv[2], "wb");
|
||||
|
||||
/* Check if files open successfully */
|
||||
if (in == NULL) {
|
||||
fprintf(stderr, "Could not open input file %s\n", argv[1]);
|
||||
return 1;
|
||||
} else if (out == NULL) {
|
||||
fprintf(stderr, "Could not open output file %s\n", argv[2]);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Write the header */
|
||||
fprintf(out, "/* Auto generated - DO NOT EDIT */\n\n#include <stdint.h>\n\n");
|
||||
fprintf(out, "static const unsigned char bytes_%s[] = {", argv[3]);
|
||||
|
||||
/* Read in chunks from buffer */
|
||||
while ((bytesRead = fread(buf, 1, sizeof(buf), in)) > 0) {
|
||||
size_t i;
|
||||
totalRead += bytesRead;
|
||||
for (i = 0; i < bytesRead; ++i) {
|
||||
int byte = ((uint8_t *)buf) [i];
|
||||
|
||||
/* Write the byte */
|
||||
if (lineIndex++ == 0) {
|
||||
if (line++)
|
||||
fputc(',', out);
|
||||
fputs("\n ", out);
|
||||
} else {
|
||||
fputs(", ", out);
|
||||
}
|
||||
fputs("0x", out);
|
||||
fputc(hex[byte >> 4], out);
|
||||
fputc(hex[byte & 0xF], out);
|
||||
|
||||
/* Make line index wrap */
|
||||
if (lineIndex >= PERLINE)
|
||||
lineIndex = 0;
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
/* Write the tail */
|
||||
fputs("\n};\n\n", out);
|
||||
|
||||
fprintf(out, "const unsigned char *%s = bytes_%s;\n\n", argv[3], argv[3]);
|
||||
|
||||
/* Write chunk size */
|
||||
fprintf(out, "int32_t %s_size = %d;\n", argv[3], totalRead);
|
||||
|
||||
/* Close the file handles */
|
||||
fclose(in);
|
||||
fclose(out);
|
||||
|
||||
return 0;
|
||||
}
|
||||
Reference in New Issue
Block a user