mirror of
https://github.com/janet-lang/janet
synced 2025-11-07 11:03:04 +00:00
Compare commits
2 Commits
v1.10.1
...
appveyor-t
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1579509a47 | ||
|
|
d3da9e7a0d |
@@ -1,12 +0,0 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
ninja
|
||||
ninja test
|
||||
@@ -1,23 +0,0 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson configure -Dsingle_threaded=true
|
||||
meson configure -Dnanbox=false
|
||||
meson configure -Ddynamic_modules=false
|
||||
meson configure -Ddocstrings=false
|
||||
meson configure -Dnet=false
|
||||
meson configure -Dsourcemaps=false
|
||||
meson configure -Dpeg=false
|
||||
meson configure -Dassembler=false
|
||||
meson configure -Dint_types=false
|
||||
meson configure -Dtyped_arrays=false
|
||||
meson configure -Dreduced_os=true
|
||||
meson configure -Dprf=false
|
||||
ninja # will not pass tests but should build
|
||||
0
.gitattributes
vendored
Normal file
0
.gitattributes
vendored
Normal file
51
CHANGELOG.md
51
CHANGELOG.md
@@ -1,54 +1,7 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.10.1 - 2020-06-18
|
||||
- Expose `janet_table_clear` in API.
|
||||
- Respect `JANET_NO_PROCESSES` define when building
|
||||
- Fix `jpm` rules having multiple copies of the same dependency.
|
||||
- Fix `jpm` install in some cases.
|
||||
- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
|
||||
to their current length.
|
||||
|
||||
## 1.10.0 - 2020-06-14
|
||||
- Hardcode default jpm paths on install so env variables are needed in fewer cases.
|
||||
- Add `:no-compile` to `create-executable` option for jpm.
|
||||
- Fix bug with the `trace` function.
|
||||
- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
|
||||
By default, threads will now consume much less memory per thread, but sending data between
|
||||
threads may cost more.
|
||||
- Fix flychecking when using the `use` macro.
|
||||
- CTRL-C no longer exits the repl, and instead cancels the current form.
|
||||
- Various small bug fixes
|
||||
- New MSI installer instead of NSIS based installer.
|
||||
- Make `os/realpath` work on windows.
|
||||
- Add polymorphic `compare` functions for comparing numbers.
|
||||
- Add `to` and `thru` peg combinators.
|
||||
- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
|
||||
- `asm` and `disasm` functions now use keywords instead of macros for keys. Also
|
||||
some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
|
||||
- Expose current macro form inside macros as (dyn :macro-form)
|
||||
- Add `tracev` macro.
|
||||
- Fix compiler bug that emitted incorrect code in some cases for while loops that create closures.
|
||||
- Add `:fresh` option to `(import ...)` to overwrite the module cache.
|
||||
- `(range x y 0)` will return an empty array instead of hanging forever.
|
||||
- Rename `jpm repl` to `jpm debug-repl`.
|
||||
|
||||
## 1.9.1 - 2020-05-12
|
||||
- Add :prefix option to declare-source
|
||||
- Re-enable minimal builds with the debugger.
|
||||
- Add several flags for configuring Janet on different platforms.
|
||||
- Fix broken meson build from 1.9.0 and add meson to CI.
|
||||
- Fix compilation issue when nanboxing is disabled.
|
||||
|
||||
## 1.9.0 - 2020-05-10
|
||||
- Add `:ldflags` option to many jpm declare functions.
|
||||
- Add `errorf` to core.
|
||||
- Add `lenprefix` combinator to PEGs.
|
||||
- Add `%M`, `%m`, `%N`, and `%n` formatters to formatting functions. These are the
|
||||
same as `%Q`, `%q`, `%P`, and `%p`, but will not truncate long values.
|
||||
- Add `fiber/root`.
|
||||
- Add beta `net/` module to core for socket based networking.
|
||||
- Add the `parse` function to parse strings of source code more conveniently.
|
||||
## Unreleased - ???
|
||||
- Add `jpm rule-tree` subcommand.
|
||||
- Add `--offline` flag to jpm to force use of the cache.
|
||||
- Allow sending pointers and C functions across threads via `thread/send`.
|
||||
@@ -69,7 +22,7 @@ All notable changes to this project will be documented in this file.
|
||||
- Add os/umask
|
||||
- Add os/perm-int
|
||||
- Add os/perm-string
|
||||
- Add :int-permissions option for os/stat.
|
||||
- Add :octal-permissions option for os/stat.
|
||||
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
|
||||
- Various bug fixes.
|
||||
|
||||
|
||||
@@ -35,9 +35,8 @@ may require changes before being merged.
|
||||
[astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
|
||||
to install this, but it can be installed with most package managers.
|
||||
|
||||
For janet code, use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible. There is a janet formatter
|
||||
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
|
||||
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible.
|
||||
|
||||
## C style
|
||||
|
||||
|
||||
51
Makefile
51
Makefile
@@ -96,7 +96,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/io.c \
|
||||
src/core/marsh.c \
|
||||
src/core/math.c \
|
||||
src/core/net.c \
|
||||
src/core/os.c \
|
||||
src/core/parse.c \
|
||||
src/core/peg.c \
|
||||
@@ -149,7 +148,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.10
|
||||
SONAME=libjanet.so.1.9
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
@@ -195,12 +194,12 @@ valgrind: $(JANET_TARGET)
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
./$(JANET_TARGET) -k jpm
|
||||
./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@@ -214,7 +213,7 @@ dist: build/janet-dist.tar.gz
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
src/include/janet.h src/conf/janetconf.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c jpm
|
||||
build/doc.html README.md build/janet.c build/shell.c auxbin/jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
@@ -233,10 +232,6 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
build/jpm: jpm $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
|
||||
chmod +x build/jpm
|
||||
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
@@ -252,7 +247,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) build/janet.pc build/jpm
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
@@ -263,7 +258,7 @@ install: $(JANET_TARGET) build/janet.pc build/jpm
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
|
||||
cp -rf auxbin/* '$(DESTDIR)$(BINDIR)'
|
||||
mkdir -p '$(DESTDIR)$(MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(MANPATH)'
|
||||
@@ -294,7 +289,6 @@ build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
|
||||
test-install:
|
||||
cd test/install \
|
||||
@@ -304,33 +298,10 @@ test-install:
|
||||
&& build/testexec \
|
||||
&& jpm --verbose quickbin testexec.janet build/testexec2 \
|
||||
&& build/testexec2 \
|
||||
&& mkdir -p modpath \
|
||||
&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
|
||||
|
||||
help:
|
||||
@echo
|
||||
@echo 'Janet: A Dynamic Language & Bytecode VM'
|
||||
@echo
|
||||
@echo Usage:
|
||||
@echo ' make Build Janet'
|
||||
@echo ' make repl Start a REPL from a built Janet'
|
||||
@echo
|
||||
@echo ' make test Test a built Janet'
|
||||
@echo ' make valgrind Assess Janet with Valgrind'
|
||||
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
|
||||
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
|
||||
@echo ' make dist Create a distribution tarball'
|
||||
@echo ' make docs Generate documentation'
|
||||
@echo ' make debug Run janet with GDB or LLDB'
|
||||
@echo ' make install Install into the current filesystem'
|
||||
@echo ' make uninstall Uninstall from the current filesystem'
|
||||
@echo ' make clean Clean intermediate build artifacts'
|
||||
@echo " make format Format Janet's own source files"
|
||||
@echo ' make grammar Generate a TextMate language grammar'
|
||||
@echo
|
||||
&& jpm --verbose --testdeps --modpath=. install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest dist uninstall docs grammar format help
|
||||
valtest emscripten dist uninstall docs grammar format
|
||||
|
||||
24
README.md
24
README.md
@@ -4,13 +4,11 @@
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/meson.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/meson_min.yml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
lisp-like language, but lists are replaced
|
||||
modern lisp, but lists are replaced
|
||||
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
@@ -37,7 +35,7 @@ Lua, but smaller than GNU Guile or Python.
|
||||
* Mutable and immutable arrays (array/tuple)
|
||||
* Mutable and immutable hashtables (table/struct)
|
||||
* Mutable and immutable strings (buffer/string)
|
||||
* Macros
|
||||
* Lisp Macros
|
||||
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tailcall Optimization
|
||||
* Direct interop with C via abstract types and C functions
|
||||
@@ -77,7 +75,7 @@ the SourceHut mirror is actively maintained.
|
||||
|
||||
## Building
|
||||
|
||||
### macOS and Unix-like
|
||||
### macos and Unix-like
|
||||
|
||||
The Makefile is non-portable and requires GNU-flavored make.
|
||||
|
||||
@@ -88,8 +86,6 @@ make test
|
||||
make repl
|
||||
```
|
||||
|
||||
Find out more about the available make targets by running `make help`.
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||
@@ -122,13 +118,6 @@ gmake repl
|
||||
3. Run `build_win` to compile janet.
|
||||
4. Run `build_win test` to make sure everything is working.
|
||||
|
||||
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
||||
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
|
||||
6. run `build_win dist`
|
||||
|
||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||
|
||||
### Meson
|
||||
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||
@@ -146,7 +135,6 @@ cd janet
|
||||
meson setup build \
|
||||
--buildtype release \
|
||||
--optimization 2 \
|
||||
--libdir /usr/local/lib \
|
||||
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
|
||||
ninja -C build
|
||||
|
||||
@@ -212,7 +200,7 @@ If installed, you can also run `man janet` and `man jpm` to get usage informatio
|
||||
Janet can be embedded in a host program very easily. The normal build
|
||||
will create a file `build/janet.c`, which is a single C file
|
||||
that contains all the source to Janet. This file, along with
|
||||
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
|
||||
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
|
||||
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||
@@ -232,10 +220,10 @@ Alternatively, check out [the #janet channel on Freenode](https://webchat.freeno
|
||||
|
||||
## FAQ
|
||||
|
||||
### Why is my terminal spitting out junk when I run the repl?
|
||||
### Why is my terminal is spitting out junk when I run the repl?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
support these, but some older terminals, Windows consoles, or embedded terminals
|
||||
support these, but some older terminals, windows consoles, or embedded terminals
|
||||
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
14
appveyor.yml
14
appveyor.yml
@@ -4,6 +4,7 @@ image:
|
||||
- Visual Studio 2019
|
||||
configuration:
|
||||
- Release
|
||||
- Debug
|
||||
platform:
|
||||
- x64
|
||||
- x86
|
||||
@@ -13,20 +14,23 @@ environment:
|
||||
matrix:
|
||||
fast_finish: true
|
||||
|
||||
# skip unsupported combinations
|
||||
init:
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
|
||||
install:
|
||||
before_build:
|
||||
- choco install nsis -y -pre --version 3.05
|
||||
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
|
||||
build_script:
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
- build_win all
|
||||
|
||||
test_script:
|
||||
- refreshenv
|
||||
# We need to reload vcvars after refreshing
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
- build_win test-install
|
||||
- set janet_outname=%appveyor_repo_tag_name%
|
||||
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
|
||||
build: off
|
||||
|
||||
artifacts:
|
||||
- name: janet.c
|
||||
@@ -44,7 +48,7 @@ artifacts:
|
||||
- name: "janet-$(janet_outname)-windows-%platform%"
|
||||
path: dist
|
||||
type: Zip
|
||||
- path: "janet-$(janet_outname)-windows-%platform%-installer.msi"
|
||||
- path: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
type: File
|
||||
|
||||
deploy:
|
||||
|
||||
740
jpm → auxbin/jpm
740
jpm → auxbin/jpm
@@ -15,167 +15,6 @@
|
||||
(def- statext (if is-win ".static.lib" ".a"))
|
||||
(def- absprefix (if is-win "C:\\" "/"))
|
||||
|
||||
#
|
||||
# Defaults
|
||||
#
|
||||
|
||||
###START###
|
||||
|
||||
# Overriden on some installs.
|
||||
(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)))
|
||||
|
||||
(defn- install-paths []
|
||||
{:headerpath (os/realpath (string exe-dir "/../include/janet"))
|
||||
:libpath (os/realpath (string exe-dir "/../lib"))
|
||||
:binpath exe-dir})
|
||||
|
||||
###END###
|
||||
|
||||
# Default based on janet binary location
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(get (install-paths) :headerpath)))
|
||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
||||
(get (install-paths) :libpath)))
|
||||
# We want setting JANET_PATH to contain installed binaries. However, it is convenient
|
||||
# to have globally installed binaries got to the same place as jpm itself, which is on
|
||||
# the $PATH.
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin"))
|
||||
(if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin"))
|
||||
(get (install-paths) :binpath)))
|
||||
|
||||
# modpath should only be derived from the syspath being used or an environment variable.
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||
|
||||
#
|
||||
# Utilities
|
||||
#
|
||||
|
||||
(defn find-manifest-dir
|
||||
"Get the path to the directory containing manifests for installed
|
||||
packages."
|
||||
[]
|
||||
(string (dyn :modpath JANET_MODPATH) sep ".manifests"))
|
||||
|
||||
(defn find-manifest
|
||||
"Get the full path of a manifest file given a package name."
|
||||
[name]
|
||||
(string (find-manifest-dir) sep name ".jdn"))
|
||||
|
||||
(defn find-cache
|
||||
"Return the path to the global cache."
|
||||
[]
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(string path sep ".cache"))
|
||||
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(case (os/lstat path :mode)
|
||||
:directory (do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
nil nil # do nothing if file does not exist
|
||||
# Default, try to remove
|
||||
(os/rm path)))
|
||||
|
||||
(defn- rimraf
|
||||
"Hard delete directory tree"
|
||||
[path]
|
||||
(if is-win
|
||||
# windows get rid of read-only files
|
||||
(when (os/stat path :mode)
|
||||
(os/shell (string `rmdir /S /Q "` path `"`)))
|
||||
(rm path)))
|
||||
|
||||
(defn clear-cache
|
||||
"Clear the global git cache."
|
||||
[]
|
||||
(def cache (find-cache))
|
||||
(print "clearing cache " cache "...")
|
||||
(rimraf cache))
|
||||
|
||||
(defn clear-manifest
|
||||
"Clear the global installation manifest."
|
||||
[]
|
||||
(def manifest (find-manifest-dir))
|
||||
(print "clearing manifests " manifest "...")
|
||||
(rimraf manifest))
|
||||
|
||||
(def- default-pkglist
|
||||
(or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
|
||||
|
||||
(defn- pslurp
|
||||
"Like slurp, but with file/popen instead file/open. Also trims output"
|
||||
[cmd]
|
||||
(string/trim (with [f (file/popen cmd)] (:read f :all))))
|
||||
|
||||
(def- path-splitter
|
||||
"split paths on / and \\."
|
||||
(peg/compile ~(any (* '(any (if-not (set `\/`) 1)) (+ (set `\/`) -1)))))
|
||||
|
||||
(defn create-dirs
|
||||
"Create all directories needed for a file (mkdir -p)."
|
||||
[dest]
|
||||
(def segs (peg/match path-splitter dest))
|
||||
(for i 1 (length segs)
|
||||
(def path (string/join (slice segs 0 i) sep))
|
||||
(unless (empty? path) (os/mkdir path))))
|
||||
|
||||
(def- filepath-replacer
|
||||
"Convert url with potential bad characters into a file path element."
|
||||
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
||||
|
||||
(defn filepath-replace
|
||||
"Remove special characters from a string or path
|
||||
to make it into a path segment."
|
||||
[repo]
|
||||
(get (peg/match filepath-replacer repo) 0))
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(if (dyn :verbose)
|
||||
(print ;(interpose " " args)))
|
||||
(def res (os/execute args :p))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(print "copying " src " to " dest "...")
|
||||
(if is-win
|
||||
(let [end (last (peg/match path-splitter src))
|
||||
isdir (= (os/stat src :mode) :directory)]
|
||||
(shell "C:\\Windows\\System32\\xcopy.exe"
|
||||
(string/replace "/" "\\" src) (string/replace "/" "\\" (if isdir (string dest "\\" end) dest))
|
||||
"/y" "/s" "/e" "/i"))
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
(defn mkdir
|
||||
"Create a directory if it doesn't exist. If it does exist, do nothing.
|
||||
If we can't create it, give a friendly error. Return true if created, false if
|
||||
existing. Throw an error if we can't create it."
|
||||
[dir]
|
||||
(os/mkdir dir))
|
||||
|
||||
(defn- abspath
|
||||
"Create an absolute path. Does not resolve . and .. (useful for
|
||||
generating entries in install manifest file)."
|
||||
[path]
|
||||
(if (if is-win
|
||||
(peg/match '(+ "\\" (* (range "AZ" "az") ":\\")) path)
|
||||
(string/has-prefix? "/" path))
|
||||
path
|
||||
(string (os/cwd) sep path)))
|
||||
|
||||
#
|
||||
# Rule Engine
|
||||
#
|
||||
@@ -188,27 +27,9 @@
|
||||
(unless item (error (string "No rule for target " target)))
|
||||
item)
|
||||
|
||||
(defn add-dep
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
[target dep]
|
||||
(def [deps] (gettarget target))
|
||||
(unless (find |(= dep $) deps)
|
||||
(array/push deps dep)))
|
||||
|
||||
(defn- add-thunk
|
||||
[target more &opt phony]
|
||||
(def item (gettarget target))
|
||||
(def [_ thunks pthunks] item)
|
||||
(array/push (if phony pthunks thunks) more)
|
||||
item)
|
||||
|
||||
(defn- rule-impl
|
||||
[target deps thunk &opt phony]
|
||||
(def rules (getrules))
|
||||
(unless (rules target) (put rules target @[(array/slice deps) @[] @[]]))
|
||||
(each d deps (add-dep target d))
|
||||
(add-thunk target thunk phony))
|
||||
(put (getrules) target @[(array/slice deps) @[thunk] phony]))
|
||||
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
@@ -232,6 +53,20 @@
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
|
||||
|
||||
(defn add-dep
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
[target dep]
|
||||
(def [deps] (gettarget target))
|
||||
(array/push deps dep))
|
||||
|
||||
(defn- add-thunk
|
||||
[target more]
|
||||
(def item (gettarget target))
|
||||
(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
|
||||
does not modify the dependency graph."
|
||||
@@ -261,11 +96,94 @@
|
||||
(error (string "No rule for file " target " found."))))
|
||||
(def [deps thunks phony] item)
|
||||
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
||||
(each thunk phony (thunk))
|
||||
(unless (empty? thunks)
|
||||
(when (needs-build-some target realdeps)
|
||||
(each thunk thunks (thunk))
|
||||
target)))
|
||||
(when (or phony (needs-build-some target realdeps))
|
||||
(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")
|
||||
(string exe-dir "/../include/janet")))
|
||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
||||
(string exe-dir "/../lib")))
|
||||
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(string (dyn :syspath) "/bin")))
|
||||
|
||||
#
|
||||
# Compilation Defaults
|
||||
#
|
||||
|
||||
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
|
||||
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
|
||||
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
|
||||
|
||||
# Detect threads
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def threads? (not (not (env 'thread/new))))
|
||||
|
||||
# Default flags for natives, but not required
|
||||
(def default-lflags (if is-win ["/nologo"] []))
|
||||
(def default-cflags
|
||||
(if is-win
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
|
||||
# Link to pthreads
|
||||
(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
|
||||
|
||||
# Required flags for dynamic libraries. These
|
||||
# are used no matter what for dynamic libraries.
|
||||
(def- dynamic-cflags
|
||||
(if is-win
|
||||
["/LD"]
|
||||
["-fPIC"]))
|
||||
(def- dynamic-lflags
|
||||
(if is-win
|
||||
["/DLL" ;thread-flags]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
|
||||
["-shared" ;thread-flags])))
|
||||
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
default value dflt if no dynamic binding is set."
|
||||
[opts key dflt]
|
||||
(def ret (or (opts key) (dyn key dflt)))
|
||||
(if (= nil ret)
|
||||
(error (string "option :" key " not set")))
|
||||
ret)
|
||||
|
||||
(defn check-cc
|
||||
"Ensure we have a c compiler."
|
||||
[]
|
||||
(if is-win
|
||||
(do
|
||||
(if (os/getenv "INCLUDE") (break))
|
||||
(error "Run jpm inside a Developer Command Prompt.
|
||||
jpm needs a c compiler to compile natives. You can install the MSVC compiler from
|
||||
microsoft.com"))
|
||||
(do)))
|
||||
|
||||
(defn create-dirs
|
||||
"Create all directories needed for a file (mkdir -p)."
|
||||
[dest]
|
||||
(def segs (string/split "/" dest))
|
||||
(for i 1 (length segs)
|
||||
(def path (string/join (slice segs 0 i) "/"))
|
||||
(unless (empty? path) (os/mkdir path))))
|
||||
|
||||
#
|
||||
# Importing a file
|
||||
@@ -319,73 +237,62 @@
|
||||
~',(reduce |(eval $1) nil body)))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
# OS and shell helpers
|
||||
#
|
||||
|
||||
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
|
||||
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
|
||||
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
|
||||
(def- path-splitter
|
||||
"split paths on / and \\."
|
||||
(peg/compile ~(any (* '(any (if-not (set `\/`) 1)) (+ (set `\/`) -1)))))
|
||||
|
||||
# Detect threads
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def threads? (not (not (env 'thread/new))))
|
||||
(def- thread-flags
|
||||
(if is-win []
|
||||
(if threads? ["-lpthread"] [])))
|
||||
(def- filepath-replacer
|
||||
"Convert url with potential bad characters into a file path element."
|
||||
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
||||
|
||||
# flags needed for the janet binary and compiling standalone
|
||||
# executables.
|
||||
(def janet-lflags
|
||||
(case (os/which)
|
||||
:macos ["-ldl" "-lm" ;thread-flags]
|
||||
:windows [;thread-flags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
|
||||
["-lm" ;thread-flags]))
|
||||
(def janet-ldflags [])
|
||||
(def janet-cflags [])
|
||||
(defn filepath-replace
|
||||
"Remove special characters from a string or path
|
||||
to make it into a path segment."
|
||||
[repo]
|
||||
(get (peg/match filepath-replacer repo) 0))
|
||||
|
||||
# Default flags for natives, but not required
|
||||
# How can we better detect the need for -pthread?
|
||||
# we probably want to better detect compiler
|
||||
(def default-lflags (if is-win ["/nologo"] []))
|
||||
(def default-cflags
|
||||
(if is-win
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
(def default-ldflags [])
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(if (dyn :verbose)
|
||||
(print ;(interpose " " args)))
|
||||
(def res (os/execute args :p))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
# Required flags for dynamic libraries. These
|
||||
# are used no matter what for dynamic libraries.
|
||||
(def- dynamic-cflags
|
||||
(if is-win
|
||||
["/LD"]
|
||||
["-fPIC"]))
|
||||
(def- dynamic-lflags
|
||||
(if is-win
|
||||
["/DLL"]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
|
||||
["-shared" ;thread-flags])))
|
||||
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
default value dflt if no dynamic binding is set."
|
||||
[opts key dflt]
|
||||
(def ret (or (opts key) (dyn key dflt)))
|
||||
(if (= nil ret)
|
||||
(error (string "option :" key " not set")))
|
||||
ret)
|
||||
|
||||
(defn check-cc
|
||||
"Ensure we have a c compiler."
|
||||
[]
|
||||
(if is-win
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if (= (os/lstat path :mode) :directory)
|
||||
(do
|
||||
(if (os/getenv "INCLUDE") (break))
|
||||
(error "Run jpm inside a Developer Command Prompt.
|
||||
jpm needs a c compiler to compile natives. You can install the MSVC compiler from
|
||||
microsoft.com"))
|
||||
(do)))
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(print "copying " src " to " dest "...")
|
||||
(if is-win
|
||||
(let [end (last (peg/match path-splitter src))
|
||||
isdir (= (os/stat src :mode) :directory)]
|
||||
(shell "xcopy" src (if isdir (string dest "\\" end) dest) "/y" "/s" "/e" "/i"))
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
(defn mkdir
|
||||
"Create a directory if it doesn't exist. If it does exist, do nothing.
|
||||
If we can't create it, give a friendly error. Return true if created, false if
|
||||
existing. Throw an error if we can't create it."
|
||||
[dir]
|
||||
(os/mkdir dir))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
#
|
||||
|
||||
(defn- embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
@@ -408,8 +315,8 @@
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(if value
|
||||
(string "-D" define "=" value)
|
||||
(string "-D" define)))
|
||||
(string (if is-win "/D" "-D") define "=" value)
|
||||
(string (if is-win "/D" "-D") define)))
|
||||
|
||||
(defn- make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
@@ -421,8 +328,8 @@
|
||||
"Generate the c flags from the input options."
|
||||
[opts]
|
||||
@[;(opt opts :cflags default-cflags)
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
|
||||
(string (if is-win "/O" "-O") (opt opts :optimize 2))])
|
||||
|
||||
(defn- entry-name
|
||||
"Name of symbol that enters static compilation of a module."
|
||||
@@ -472,14 +379,13 @@
|
||||
(def cflags (getcflags opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
(def ldflags [;(opt opts :ldflags [])])
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(create-dirs target)
|
||||
(if is-win
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
(shell linker ;lflags (string "/OUT:" target) ;objects (win-import-library))
|
||||
(shell linker ;cflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- archive-c
|
||||
"Link object files together to make a static library."
|
||||
@@ -528,9 +434,68 @@
|
||||
[path]
|
||||
(string (string/slice path 0 (- -1 (length modext))) statext))
|
||||
|
||||
(defn- make-bin-source
|
||||
[declarations lookup-into-invocations]
|
||||
(string
|
||||
(defn- create-executable
|
||||
"Links an image with libjanet.a (or .lib) to produce an
|
||||
executable. Also will try to link native modules into the
|
||||
final executable as well."
|
||||
[opts source dest]
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
(rule dest [source]
|
||||
(check-cc)
|
||||
(print "generating executable c source...")
|
||||
(create-dirs dest)
|
||||
# Load entry environment and get main function.
|
||||
(def entry-env (dofile source))
|
||||
(def main ((entry-env 'main) :value))
|
||||
(def dep-lflags @[])
|
||||
|
||||
# Create marshalling dictionary
|
||||
(def mdict (invert (env-lookup root-env)))
|
||||
# Load all native modules
|
||||
(def prefixes @{})
|
||||
(def static-libs @[])
|
||||
(loop [[name m] :pairs module/cache
|
||||
:let [n (m :native)]
|
||||
:when n
|
||||
:let [prefix (gensym)]]
|
||||
(print "found native " n "...")
|
||||
(put prefixes prefix n)
|
||||
(array/push static-libs (modpath-to-static n))
|
||||
(def oldproto (table/getproto m))
|
||||
(table/setproto m nil)
|
||||
(loop [[sym value] :pairs (env-lookup m)]
|
||||
(put mdict value (symbol prefix sym)))
|
||||
(table/setproto m oldproto))
|
||||
|
||||
# Find static modules
|
||||
(def declarations @"")
|
||||
(def lookup-into-invocations @"")
|
||||
(loop [[prefix name] :pairs prefixes]
|
||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
||||
(buffer/push-string lookup-into-invocations
|
||||
" temptab = janet_table(0);\n"
|
||||
" temptab->proto = env;\n"
|
||||
" " (meta :static-entry) "(temptab);\n"
|
||||
" janet_env_lookup_into(lookup, temptab, \""
|
||||
prefix
|
||||
"\", 0);\n\n")
|
||||
(when-let [lfs (meta :lflags)]
|
||||
(array/concat dep-lflags lfs))
|
||||
(buffer/push-string declarations
|
||||
"extern void "
|
||||
(meta :static-entry)
|
||||
"(JanetTable *);\n"))
|
||||
|
||||
|
||||
# Build image
|
||||
(def image (marshal main mdict))
|
||||
# Make image byte buffer
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (string
|
||||
"\n"
|
||||
declarations
|
||||
```
|
||||
|
||||
@@ -586,110 +551,73 @@ int main(int argc, const char **argv) {
|
||||
fiber->env = temptab;
|
||||
Janet out;
|
||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (result != JANET_SIGNAL_OK && result != JANET_SIGNAL_EVENT) {
|
||||
if (result) {
|
||||
janet_stacktrace(fiber, out);
|
||||
janet_deinit();
|
||||
return result;
|
||||
}
|
||||
#ifdef JANET_NET
|
||||
janet_loop();
|
||||
#endif
|
||||
janet_deinit();
|
||||
return 0;
|
||||
}
|
||||
|
||||
```))
|
||||
```) :ab)
|
||||
|
||||
(defn- create-executable
|
||||
"Links an image with libjanet.a (or .lib) to produce an
|
||||
executable. Also will try to link native modules into the
|
||||
final executable as well."
|
||||
[opts source dest]
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
(def no-compile (opts :no-compile))
|
||||
(rule (if no-compile cimage_dest dest) [source]
|
||||
(check-cc)
|
||||
(print "generating executable c source...")
|
||||
(create-dirs dest)
|
||||
# Load entry environment and get main function.
|
||||
(def entry-env (dofile source))
|
||||
(def main ((entry-env 'main) :value))
|
||||
(def dep-lflags @[])
|
||||
(def dep-ldflags @[])
|
||||
|
||||
# Create marshalling dictionary
|
||||
(def mdict (invert (env-lookup root-env)))
|
||||
# Load all native modules
|
||||
(def prefixes @{})
|
||||
(def static-libs @[])
|
||||
(loop [[name m] :pairs module/cache
|
||||
:let [n (m :native)]
|
||||
:when n
|
||||
:let [prefix (gensym)]]
|
||||
(print "found native " n "...")
|
||||
(put prefixes prefix n)
|
||||
(array/push static-libs (modpath-to-static n))
|
||||
(def oldproto (table/getproto m))
|
||||
(table/setproto m nil)
|
||||
(loop [[sym value] :pairs (env-lookup m)]
|
||||
(put mdict value (symbol prefix sym)))
|
||||
(table/setproto m oldproto))
|
||||
|
||||
# Find static modules
|
||||
(def declarations @"")
|
||||
(def lookup-into-invocations @"")
|
||||
(loop [[prefix name] :pairs prefixes]
|
||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
||||
(buffer/push-string lookup-into-invocations
|
||||
" temptab = janet_table(0);\n"
|
||||
" temptab->proto = env;\n"
|
||||
" " (meta :static-entry) "(temptab);\n"
|
||||
" janet_env_lookup_into(lookup, temptab, \""
|
||||
prefix
|
||||
"\", 0);\n\n")
|
||||
(when-let [lfs (meta :lflags)]
|
||||
(array/concat dep-lflags lfs))
|
||||
(when-let [lfs (meta :ldflags)]
|
||||
(array/concat dep-ldflags lfs))
|
||||
(buffer/push-string declarations
|
||||
"extern void "
|
||||
(meta :static-entry)
|
||||
"(JanetTable *);\n"))
|
||||
|
||||
# Build image
|
||||
(def image (marshal main mdict))
|
||||
# Make image byte buffer
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
|
||||
# Compile and link final exectable
|
||||
(unless no-compile
|
||||
(do
|
||||
(def extra-lflags (case (os/which)
|
||||
:macos ["-ldl" "-lm" ;thread-flags]
|
||||
:windows [;thread-flags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
|
||||
#default
|
||||
["-lm" ;thread-flags]))
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags])
|
||||
(def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
|
||||
(def cflags [;(getcflags opts) ;janet-cflags])
|
||||
(def lflags [;dep-lflags ;(opt opts :lflags default-lflags) ;extra-lflags])
|
||||
(def cflags (getcflags opts))
|
||||
(def defines (make-defines (opt opts :defines {})))
|
||||
(print "compiling and linking " dest "...")
|
||||
(if is-win
|
||||
(shell cc ;cflags ;ldflags cimage_dest ;lflags `/link` (string "/OUT:" dest))
|
||||
(shell cc ;cflags ;ldflags `-o` dest cimage_dest ;lflags)))))
|
||||
(shell cc ;cflags cimage_dest ;static-libs (libjanet) ;lflags `/link` (string "/OUT:" dest))
|
||||
(shell cc ;cflags `-o` dest cimage_dest ;static-libs (libjanet) ;lflags)))))
|
||||
|
||||
(defn- abspath
|
||||
"Create an absolute path. Does not resolve . and .. (useful for
|
||||
generating entries in install manifest file)."
|
||||
[path]
|
||||
(if (if is-win
|
||||
(peg/match '(+ "\\" (* (range "AZ" "az") ":\\")) path)
|
||||
(string/has-prefix? "/" path))
|
||||
path
|
||||
(string (os/cwd) sep path)))
|
||||
|
||||
#
|
||||
# Installation and Dependencies
|
||||
# Public utilities
|
||||
#
|
||||
|
||||
(var- stored-git-path nil)
|
||||
(defn- git-path
|
||||
"Get the location of git such that it can be passed as an argument to os/execute."
|
||||
"(Some builds/configurations of windows don't like just the string 'git')"
|
||||
(defn parse
|
||||
"Read a string of Janet source and parse out the first expression."
|
||||
[src]
|
||||
(let [p (parser/new)]
|
||||
(:consume p src)
|
||||
(if (= :error (:status p))
|
||||
(error (string "Could not parse: " (parser/error p))))
|
||||
(:produce p)))
|
||||
|
||||
(defn find-manifest-dir
|
||||
"Get the path to the directory containing manifests for installed
|
||||
packages."
|
||||
[]
|
||||
(if stored-git-path (break stored-git-path))
|
||||
(set stored-git-path
|
||||
(if is-win
|
||||
(or (os/getenv "JANET_GIT") (pslurp "where git"))
|
||||
(os/getenv "JANET_GIT" "git"))))
|
||||
(string (dyn :modpath JANET_MODPATH) sep ".manifests"))
|
||||
|
||||
(defn find-manifest
|
||||
"Get the full path of a manifest file given a package name."
|
||||
[name]
|
||||
(string (find-manifest-dir) sep name ".jdn"))
|
||||
|
||||
(defn find-cache
|
||||
"Return the path to the global cache."
|
||||
[]
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(string path sep ".cache"))
|
||||
|
||||
(defn uninstall
|
||||
"Uninstall bundle named name"
|
||||
@@ -700,11 +628,27 @@ int main(int argc, const char **argv) {
|
||||
(each path (get man :paths [])
|
||||
(print "removing " path)
|
||||
(rm path))
|
||||
(print "removing manifest " manifest)
|
||||
(:close f) # I hate windows
|
||||
(print "removing " manifest)
|
||||
(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 "...")
|
||||
(rimraf cache))
|
||||
|
||||
(def- default-pkglist (or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
|
||||
|
||||
(defn install-git
|
||||
"Install a bundle from git. If the bundle is already installed, the bundle
|
||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
||||
@@ -740,7 +684,7 @@ int main(int argc, const char **argv) {
|
||||
(when (mkdir module-dir)
|
||||
(set fresh true)
|
||||
(print "cloning repository " repo " to " module-dir)
|
||||
(unless (zero? (os/execute [(git-path) "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))
|
||||
@@ -752,11 +696,11 @@ int main(int argc, const char **argv) {
|
||||
:binpath (abspath (dyn :binpath JANET_BINPATH))]
|
||||
(os/cd module-dir)
|
||||
(unless fresh
|
||||
(os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
|
||||
(os/execute ["git" "pull" "origin" "master"] :p))
|
||||
(when tag
|
||||
(os/execute [(git-path) "reset" "--hard" tag] :p))
|
||||
(os/execute ["git" "reset" "--hard" tag] :p))
|
||||
(unless (dyn :offline)
|
||||
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
|
||||
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p))
|
||||
(import-rules "./project.janet")
|
||||
(unless no-deps (do-rule "install-deps"))
|
||||
(do-rule "build")
|
||||
@@ -771,10 +715,15 @@ int main(int argc, const char **argv) {
|
||||
(def name (last parts))
|
||||
(def path (string destdir sep name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(phony "install" []
|
||||
(add-body "install"
|
||||
(mkdir destdir)
|
||||
(copy src destdir)))
|
||||
|
||||
(defn- pslurp
|
||||
"Like slurp, but with file/popen instead file/open. Also trims output"
|
||||
[cmd]
|
||||
(string/trim (with [f (file/popen cmd)] (:read f :all))))
|
||||
|
||||
(defn- make-lockfile
|
||||
[&opt filename]
|
||||
(default filename "lockfile.jdn")
|
||||
@@ -803,15 +752,8 @@ int main(int argc, const char **argv) {
|
||||
(unless made-progress
|
||||
(error (string/format "could not resolve package order for: %j"
|
||||
(filter (complement resolved) (map |($ :repo) packages))))))
|
||||
# Write to file, manual format for better diffs.
|
||||
(with [f (file/open filename :w)]
|
||||
(with-dyns [:out f]
|
||||
(prin "@[")
|
||||
(eachk i ordered-packages
|
||||
(unless (zero? i)
|
||||
(prin "\n "))
|
||||
(prinf "%j" (ordered-packages i)))
|
||||
(print "]"))))
|
||||
# Write to file
|
||||
(with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages))))
|
||||
|
||||
(defn- load-lockfile
|
||||
[&opt filename]
|
||||
@@ -859,7 +801,6 @@ int main(int argc, const char **argv) {
|
||||
"# Metadata for static library %s\n\n%.20p"
|
||||
(string name statext)
|
||||
{:static-entry ename
|
||||
:ldflags ~',(opts :ldflags)
|
||||
:lflags ~',(opts :lflags)})))
|
||||
(add-dep "build" metaname)
|
||||
(install-rule metaname path)
|
||||
@@ -885,13 +826,10 @@ int main(int argc, const char **argv) {
|
||||
(install-rule sname path)))
|
||||
|
||||
(defn declare-source
|
||||
"Create Janet modules. This does not actually build the module(s),
|
||||
but registers them for packaging and installation. :source should be an
|
||||
array of files and directores to copy into JANET_MODPATH or JANET_PATH.
|
||||
:prefix can optionally be given to modify the destination path to be
|
||||
(string JANET_PATH prefix source)."
|
||||
[&keys {:source sources :prefix prefix}]
|
||||
(def path (string (dyn :modpath JANET_MODPATH) (or prefix "")))
|
||||
"Create a Janet modules. This does not actually build the module(s),
|
||||
but registers it for packaging and installation."
|
||||
[&keys {:source sources}]
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(if (bytes? sources)
|
||||
(install-rule sources path)
|
||||
(each s sources
|
||||
@@ -908,46 +846,25 @@ int main(int argc, const char **argv) {
|
||||
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
|
||||
:cflags cflags :lflags lflags :deps deps :ldflags ldflags
|
||||
:no-compile no-compile}]
|
||||
:cflags cflags :lflags lflags :deps deps}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
|
||||
(if no-compile
|
||||
(let [cdest (string dest ".c")]
|
||||
(add-dep "build" cdest))
|
||||
(do
|
||||
(create-executable @{:cflags cflags :lflags lflags} entry dest)
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
(when deps
|
||||
(each d deps (add-dep dest d)))
|
||||
(when install
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))))
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script. Creates
|
||||
a shim on windows. If hardcode is true, will insert code into the script
|
||||
such that it will run correctly even when JANET_PATH is changed."
|
||||
[&keys {:main main :hardcode-syspath hardcode}]
|
||||
a shim on windows."
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def binpath (dyn :binpath JANET_BINPATH))
|
||||
(if hardcode
|
||||
(let [syspath (dyn :modpath JANET_MODPATH)]
|
||||
(def parts (peg/match path-splitter main))
|
||||
(def name (last parts))
|
||||
(def path (string binpath sep name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(phony "install" []
|
||||
(def contents
|
||||
(with [f (file/open main)]
|
||||
(def first-line (:read f :line))
|
||||
(def second-line (string/format "(put root-env :syspath %v)\n" syspath))
|
||||
(def rest (:read f :all))
|
||||
(string first-line second-line rest)))
|
||||
(create-dirs path)
|
||||
(spit path contents)
|
||||
(unless is-win (shell "chmod" "+x" path))))
|
||||
(install-rule main binpath))
|
||||
(install-rule main binpath)
|
||||
# Create a dud batch file when on windows.
|
||||
(when is-win
|
||||
(def name (last (peg/match path-splitter main)))
|
||||
@@ -955,7 +872,7 @@ int main(int argc, const char **argv) {
|
||||
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
|
||||
(def newname (string binpath sep name ".bat"))
|
||||
(array/push (dyn :installed-files) newname)
|
||||
(phony "install" []
|
||||
(add-body "install"
|
||||
(spit newname bat))))
|
||||
|
||||
(defn- print-rule-tree
|
||||
@@ -1002,12 +919,11 @@ int main(int argc, const char **argv) {
|
||||
|
||||
(phony "build" [])
|
||||
|
||||
(phony "manifest" [manifest])
|
||||
(rule manifest []
|
||||
(phony "manifest" []
|
||||
(print "generating " manifest "...")
|
||||
(mkdir manifests)
|
||||
(def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
|
||||
(def url (pslurp (string "\"" (git-path) "\" remote get-url origin")))
|
||||
(def sha (pslurp "git rev-parse HEAD"))
|
||||
(def url (pslurp "git remote get-url origin"))
|
||||
(def man
|
||||
{:sha (if-not (empty? sha) sha)
|
||||
:repo (if-not (empty? url) url)
|
||||
@@ -1015,7 +931,7 @@ int main(int argc, const char **argv) {
|
||||
:paths installed-files})
|
||||
(spit manifest (string/format "%j\n" man)))
|
||||
|
||||
(phony "install" ["uninstall" "build" manifest]
|
||||
(phony "install" ["uninstall" "build" "manifest"]
|
||||
(when (dyn :test)
|
||||
(do-rule "test"))
|
||||
(print "Installed as '" (meta :name) "'."))
|
||||
@@ -1073,17 +989,16 @@ on a project, or from anywhere to do operations on the global module cache (modp
|
||||
Subcommands are:
|
||||
build : build all artifacts
|
||||
help : show this help text
|
||||
install (repo or name)... : install artifacts. If a repo is given, install the contents of that
|
||||
install (repo or name) : install artifacts. If a repo is given, install the contents of that
|
||||
git repository, assuming that the repository is a jpm project. If not, build
|
||||
and install the current project.
|
||||
uninstall (module)... : uninstall a module. If no module is given, uninstall the module
|
||||
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.
|
||||
clear-cache : clear the git cache. Useful for updating dependencies.
|
||||
clear-manifest : clear the manifest. Useful for fixing broken installs.
|
||||
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
||||
or (rule "ouput.file" [deps...] ...).
|
||||
rules : list rules available with run.
|
||||
@@ -1099,7 +1014,7 @@ Subcommands are:
|
||||
name is lockfile.jdn.
|
||||
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
|
||||
default lockfile name is lockfile.jdn.
|
||||
debug-repl : Run a repl in the context of the current project.janet file. This lets you run rules and
|
||||
repl : Run a repl in the context of the current project.janet file. This lets you run rules and
|
||||
otherwise debug the current project.janet file.
|
||||
|
||||
Keys are:
|
||||
@@ -1141,20 +1056,20 @@ Flags are:
|
||||
(local-rule "clean"))
|
||||
|
||||
(defn install
|
||||
[& repo]
|
||||
(if (empty? repo)
|
||||
(local-rule "install")
|
||||
(each rep repo (install-git rep))))
|
||||
[&opt repo]
|
||||
(if repo
|
||||
(install-git repo)
|
||||
(local-rule "install")))
|
||||
|
||||
(defn test
|
||||
[]
|
||||
(local-rule "test"))
|
||||
|
||||
(defn- uninstall-cmd
|
||||
[& what]
|
||||
(if (empty? what)
|
||||
(local-rule "uninstall")
|
||||
(each wha what (uninstall wha))))
|
||||
[&opt what]
|
||||
(if what
|
||||
(uninstall what)
|
||||
(local-rule "uninstall")))
|
||||
|
||||
(defn deps
|
||||
[]
|
||||
@@ -1184,7 +1099,7 @@ Flags are:
|
||||
(create-executable @{} input output)
|
||||
(do-rule output))
|
||||
|
||||
(defn jpm-debug-repl
|
||||
(defn jpm-repl
|
||||
[]
|
||||
(def env
|
||||
(try
|
||||
@@ -1213,11 +1128,10 @@ Flags are:
|
||||
"test" test
|
||||
"help" help
|
||||
"deps" deps
|
||||
"debug-repl" jpm-debug-repl
|
||||
"repl" jpm-repl
|
||||
"rule-tree" show-rule-tree
|
||||
"show-paths" show-paths
|
||||
"clear-cache" clear-cache
|
||||
"clear-manifest" clear-manifest
|
||||
"run" local-rule
|
||||
"rules" list-rules
|
||||
"update-pkgs" update-pkgs
|
||||
@@ -116,34 +116,23 @@ copy src\include\janet.h dist\janet.h
|
||||
copy src\conf\janetconf.h dist\janetconf.h
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy .\jpm dist\jpm
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
|
||||
janet.exe -e "(print (os/arch))" > build\arch.txt
|
||||
janet.exe -e "(print (= (os/arch) :x64))" > build\64bit.txt
|
||||
set /p JANET_VERSION= < build\version.txt
|
||||
set /p BUILDARCH= < build\arch.txt
|
||||
set /p SIXTYFOUR= < build\64bit.txt
|
||||
echo "JANET_VERSION is %JANET_VERSION%"
|
||||
if defined APPVEYOR_REPO_TAG_NAME (
|
||||
set RELEASE_VERSION=%APPVEYOR_REPO_TAG_NAME%
|
||||
) else (
|
||||
set RELEASE_VERSION=%JANET_VERSION%
|
||||
)
|
||||
if defined CI (
|
||||
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
|
||||
) else (
|
||||
set WIXBIN=
|
||||
)
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
|
||||
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
|
||||
"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)
|
||||
:INSTALL
|
||||
FOR %%a in (janet-*-windows-*-installer.msi) DO (
|
||||
@echo Running Installer %%a...
|
||||
%%a /QN
|
||||
@echo Running Installer...
|
||||
FOR %%a in (janet-*-windows-*-installer.exe) DO (
|
||||
%%a /S /CurrentUser
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
|
||||
@@ -1,4 +1,10 @@
|
||||
(import build/numarray)
|
||||
(import cook)
|
||||
|
||||
(cook/make-native
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
|
||||
(import build/numarray :as numarray)
|
||||
|
||||
(def a (numarray/new 30))
|
||||
(print (get a 20))
|
||||
@@ -23,7 +23,7 @@ static int num_array_gc(void *p, size_t s) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int num_array_get(void *p, Janet key, Janet *out);
|
||||
Janet num_array_get(void *p, Janet key);
|
||||
void num_array_put(void *p, Janet key, Janet value);
|
||||
|
||||
static const JanetAbstractType num_array_type = {
|
||||
@@ -31,8 +31,7 @@ static const JanetAbstractType num_array_type = {
|
||||
num_array_gc,
|
||||
NULL,
|
||||
num_array_get,
|
||||
num_array_put,
|
||||
JANET_ATEND_PUT
|
||||
num_array_put
|
||||
};
|
||||
|
||||
static Janet num_array_new(int32_t argc, Janet *argv) {
|
||||
@@ -82,20 +81,21 @@ static const JanetMethod methods[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
int num_array_get(void *p, Janet key, Janet *out) {
|
||||
Janet num_array_get(void *p, Janet key) {
|
||||
size_t index;
|
||||
Janet value;
|
||||
num_array *array = (num_array *)p;
|
||||
if (janet_checktype(key, JANET_KEYWORD))
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods, out);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods);
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = (size_t)janet_unwrap_integer(key);
|
||||
if (index >= array->size) {
|
||||
return 0;
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
*out = janet_wrap_number(array->data[index]);
|
||||
value = janet_wrap_number(array->data[index]);
|
||||
}
|
||||
return 1;
|
||||
return value;
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
|
||||
@@ -1,7 +0,0 @@
|
||||
(declare-project
|
||||
:name "numarray"
|
||||
:description "Example c lib with abstract type")
|
||||
|
||||
(declare-native
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
@@ -1,6 +0,0 @@
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(printf "Connected to %q!" conn)
|
||||
(:write conn "Echo...")
|
||||
(print "Wrote to connection...")
|
||||
(def res (:read conn 1024))
|
||||
(pp res))
|
||||
@@ -1,13 +0,0 @@
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)))
|
||||
|
||||
(net/server "127.0.0.1" "8000" handler)
|
||||
216
janet-installer.nsi
Normal file
216
janet-installer.nsi
Normal file
@@ -0,0 +1,216 @@
|
||||
# This file is invoked by build_win.bat
|
||||
# Relevant configuration variables are set there.
|
||||
|
||||
Unicode True
|
||||
|
||||
!echo "Program Files: ${PROGRAMFILES}"
|
||||
!addplugindir "tools\"
|
||||
|
||||
# Version
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
|
||||
# Use the modern UI
|
||||
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||
!define MULTIUSER_MUI
|
||||
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
!if ${SIXTYFOUR} == "true"
|
||||
!define MULTIUSER_USE_PROGRAMFILES64
|
||||
!define PLATNAME "x64"
|
||||
!else
|
||||
!define PLATNAME "x86"
|
||||
!endif
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
!include "MUI2.nsh"
|
||||
!include "LogicLib.nsh"
|
||||
|
||||
# Basics
|
||||
Name "Janet"
|
||||
|
||||
# Do some NSIS-fu to figure out at compile time if we are in appveyor
|
||||
!define OUTNAME $%APPVEYOR_REPO_TAG_NAME%
|
||||
!define "CHECK_${OUTNAME}"
|
||||
!define DOLLAR "$"
|
||||
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
|
||||
# We are not in the appveyor environment, use version name
|
||||
!define OUTNAME_PART ${VERSION}
|
||||
!else
|
||||
# We are in appveyor, use git tag name for installer
|
||||
!define OUTNAME_PART ${OUTNAME}
|
||||
!endif
|
||||
OutFile "janet-${OUTNAME_PART}-windows-${PLATNAME}-installer.exe"
|
||||
|
||||
# Some Configuration
|
||||
!define APPNAME "Janet"
|
||||
!define DESCRIPTION "The Janet Programming Language"
|
||||
!define HELPURL "http://janet-lang.org"
|
||||
BrandingText "The Janet Programming Language"
|
||||
|
||||
# Macros for setting registry values
|
||||
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
|
||||
!macro WriteEnv key value
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
|
||||
${Else}
|
||||
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
!macro DelEnv key
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
|
||||
${Else}
|
||||
DeleteRegValue HKCU "Environment" "${key}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
|
||||
# MUI Configuration
|
||||
!define MUI_ICON "assets\icon.ico"
|
||||
!define MUI_UNICON "assets\icon.ico"
|
||||
!define MUI_HEADERIMAGE
|
||||
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
||||
!define MUI_HEADERIMAGE_RIGHT
|
||||
!define MUI_ABORTWARNING
|
||||
|
||||
# Show a welcome page first
|
||||
!insertmacro MUI_PAGE_WELCOME
|
||||
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||
|
||||
# Pick Install Directory
|
||||
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||
!insertmacro MUI_PAGE_DIRECTORY
|
||||
!insertmacro MUI_PAGE_INSTFILES
|
||||
|
||||
# Done
|
||||
!insertmacro MUI_PAGE_FINISH
|
||||
|
||||
# Need to set a language.
|
||||
!insertmacro MUI_LANGUAGE "English"
|
||||
|
||||
function .onInit
|
||||
!insertmacro MULTIUSER_INIT
|
||||
functionEnd
|
||||
|
||||
section "Janet" BfWSection
|
||||
|
||||
createDirectory "$INSTDIR\Library"
|
||||
createDirectory "$INSTDIR\C"
|
||||
createDirectory "$INSTDIR\bin"
|
||||
createDirectory "$INSTDIR\docs"
|
||||
setOutPath "$INSTDIR"
|
||||
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
file /oname=logo.ico assets\icon.ico
|
||||
file /oname=bin\jpm.janet auxbin\jpm
|
||||
file /oname=bin\jpm.bat tools\jpm.bat
|
||||
|
||||
# C headers and library files
|
||||
file /oname=C\janet.h dist\janet.h
|
||||
file /oname=C\janetconf.h dist\janetconf.h
|
||||
file /oname=C\janet.lib dist\janet.lib
|
||||
file /oname=C\janet.exp dist\janet.exp
|
||||
file /oname=C\janet.c dist\janet.c
|
||||
file /oname=C\libjanet.lib dist\libjanet.lib
|
||||
|
||||
# Documentation
|
||||
file /oname=docs\docs.html dist\doc.html
|
||||
|
||||
# Other
|
||||
file README.md
|
||||
file LICENSE
|
||||
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Start Menu
|
||||
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"
|
||||
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
||||
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
||||
# Add uninstall
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
|
||||
|
||||
sectionEnd
|
||||
|
||||
# Uninstaller
|
||||
|
||||
function un.onInit
|
||||
!insertmacro MULTIUSER_UNINIT
|
||||
functionEnd
|
||||
|
||||
section "uninstall"
|
||||
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
|
||||
# Remove files
|
||||
delete "$INSTDIR\logo.ico"
|
||||
delete "$INSTDIR\README.md"
|
||||
delete "$INSTDIR\LICENSE"
|
||||
rmdir /r "$INSTDIR\Library"
|
||||
rmdir /r "$INSTDIR\bin"
|
||||
rmdir /r "$INSTDIR\C"
|
||||
rmdir /r "$INSTDIR\docs"
|
||||
|
||||
# Remove env vars
|
||||
!insertmacro DelEnv JANET_PATH
|
||||
!insertmacro DelEnv JANET_HEADERPATH
|
||||
!insertmacro DelEnv JANET_LIBPATH
|
||||
!insertmacro DelEnv JANET_BINPATH
|
||||
|
||||
# Unset PATH
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
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
|
||||
|
||||
# Always delete uninstaller as the last action
|
||||
delete "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Remove uninstaller information from the registry
|
||||
DeleteRegKey SHCTX "${UNINST_KEY}"
|
||||
|
||||
sectionEnd
|
||||
6
janet.1
6
janet.1
@@ -13,8 +13,8 @@ janet \- run the Janet language abstract machine
|
||||
.BR args ...
|
||||
.SH DESCRIPTION
|
||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||
It is a Lisp-like language, but lists are replaced by other data structures
|
||||
(arrays, tables, structs, tuples). The language also features bridging
|
||||
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||
and performance (arrays, tables, structs, tuples). The language also features bridging
|
||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a repl for trying out the language, as well as the ability to run script files.
|
||||
@@ -175,7 +175,7 @@ after an error. Persistent mode can be good for debugging and testing.
|
||||
|
||||
.TP
|
||||
.BR \-q
|
||||
Hide the logo in the repl.
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
|
||||
.TP
|
||||
.BR \-k
|
||||
|
||||
26
jpm.1
26
jpm.1
@@ -26,7 +26,7 @@ More interesting are the local commands. For more information on jpm usage, see
|
||||
|
||||
.TP
|
||||
.BR \-\-nocolor
|
||||
Disable color in the jpm debug repl.
|
||||
Disable color in the jpm repl.
|
||||
|
||||
.TP
|
||||
.BR \-\-verbose
|
||||
@@ -100,20 +100,19 @@ Builds all artifacts specified in the project.janet file in the current director
|
||||
be created in the ./build/ directory.
|
||||
|
||||
.TP
|
||||
.BR install\ [\fBrepo...\fR]
|
||||
.BR install\ [\fBrepo\fR]
|
||||
|
||||
When run with no arguments, installs all installable artifacts in the current project to
|
||||
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
||||
take an optional git repository URL and will install all artifacts in that repository instead.
|
||||
When run with an argument, install does not need to be run from a jpm project directory. Will also
|
||||
install multiple dependencies in one command.
|
||||
When run with an argument, install does not need to be run from a jpm project directory.
|
||||
|
||||
.TP
|
||||
.BR uninstall\ [\fBname...\fR]
|
||||
.BR uninstall\ [\fBname\fR]
|
||||
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
||||
repository url, path to installed file or executable name. The name of the project must be specified
|
||||
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
||||
the current project if installed. Will also uninstall multiple packages in one command.
|
||||
the current project if installed.
|
||||
|
||||
.TP
|
||||
.BR clean
|
||||
@@ -139,14 +138,6 @@ date or too large, clear-cache will remove the cache and jpm will rebuild it
|
||||
when needed. clear-cache is a global command, so a project.janet is not
|
||||
required.
|
||||
|
||||
.TP
|
||||
.BR clear-manifest
|
||||
jpm creates a manifest directory that contains a list of all installed files.
|
||||
By deleting this directory, jpm will think that nothing is installed and will
|
||||
try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with
|
||||
this command, as it may leave extra files on your system and shouldn't be needed
|
||||
most of the time in a healthy install.
|
||||
|
||||
.TP
|
||||
.BR run\ [\fBrule\fR]
|
||||
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
|
||||
@@ -180,7 +171,7 @@ as function arguments. The entry file can import other modules, including native
|
||||
jpm will attempt to include the dependencies into the generated executable.
|
||||
|
||||
.TP
|
||||
.BR debug-repl
|
||||
.BR repl
|
||||
Load the current project.janet file and start a repl in it's environment. This lets a user better
|
||||
debug the project file, as well as run rules manually.
|
||||
|
||||
@@ -245,10 +236,5 @@ The git repository URL that contains a listing of packages. This allows installi
|
||||
is mostly a convenience. However, package dependencies can use short names, package listings
|
||||
can be used to choose a particular set of dependency versions for a whole project.
|
||||
|
||||
.B JANET_GIT
|
||||
.RS
|
||||
An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
|
||||
if you have a normal install of git.
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
30
meson.build
30
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.10.1')
|
||||
version : '1.9.0-dev')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -59,7 +59,6 @@ conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
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'))
|
||||
@@ -68,9 +67,6 @@ conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||
conf.set('JANET_STACK_MAX', get_option('stack_max'))
|
||||
conf.set('JANET_NO_UMASK', not get_option('umask'))
|
||||
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
|
||||
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -116,7 +112,6 @@ core_src = [
|
||||
'src/core/io.c',
|
||||
'src/core/marsh.c',
|
||||
'src/core/math.c',
|
||||
'src/core/net.c',
|
||||
'src/core/os.c',
|
||||
'src/core/parse.c',
|
||||
'src/core/peg.c',
|
||||
@@ -224,8 +219,7 @@ test_files = [
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet',
|
||||
'test/suite8.janet',
|
||||
'test/suite9.janet'
|
||||
'test/suite8.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -245,18 +239,10 @@ pkg.generate(libjanet,
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
if get_option('peg') and not get_option('reduced_os') and get_option('processes')
|
||||
install_man('jpm.1')
|
||||
patched_jpm = custom_target('patched-jpm',
|
||||
input : ['tools/patch-jpm.janet', 'jpm'],
|
||||
install : true,
|
||||
install_dir : get_option('bindir'),
|
||||
build_by_default : true,
|
||||
output : ['jpm'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
|
||||
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
|
||||
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'),
|
||||
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
|
||||
endif
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
|
||||
@@ -11,10 +11,6 @@ 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('net', type : 'boolean', value : true)
|
||||
option('processes', type : 'boolean', value : true)
|
||||
option('umask', type : 'boolean', value : true)
|
||||
option('realpath', 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)
|
||||
|
||||
@@ -141,11 +141,6 @@
|
||||
[x &opt err]
|
||||
(if x x (error (if err err "assert failure"))))
|
||||
|
||||
(defn errorf
|
||||
"A combination of error and string/format. Equivalent to (error (string/format fmt ;args))"
|
||||
[fmt & args]
|
||||
(error (string/format fmt ;args)))
|
||||
|
||||
(defmacro default
|
||||
"Define a default value for an optional argument.
|
||||
Expands to (def sym (if (= nil sym) val sym))"
|
||||
@@ -667,68 +662,6 @@
|
||||
[xs]
|
||||
(get xs (- (length xs) 1)))
|
||||
|
||||
## Polymorphic comparisons
|
||||
|
||||
(defn compare-primitive
|
||||
"Compare x and y using primitive operators.
|
||||
Returns -1,0,1 for x < y, x = y, x > y respectively.
|
||||
Present mostly for constructing 'compare' methods in prototypes."
|
||||
[x y]
|
||||
(cond
|
||||
(= x y) 0
|
||||
(< x y) -1
|
||||
(> x y) 1))
|
||||
|
||||
(defn compare
|
||||
"Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively.
|
||||
Differs from the primitive comparators in that it first checks to
|
||||
see whether either x or y implement a 'compare' method which can
|
||||
compare x and y. If so it uses that compare method. If not, it
|
||||
delegates to the primitive comparators."
|
||||
[x y]
|
||||
(or
|
||||
(when-let [f (get x :compare)] (f x y))
|
||||
(when-let [f (get y :compare)
|
||||
fyx (f y x)] (- fyx))
|
||||
(compare-primitive x y)))
|
||||
|
||||
(defn- compare-reduce [op xs]
|
||||
(var r true)
|
||||
(loop [i :range [0 (- (length xs) 1)]
|
||||
:let [c (compare (xs i) (xs (+ i 1)))
|
||||
ok (op c 0)]
|
||||
:when (not ok)]
|
||||
(set r false)
|
||||
(break))
|
||||
r)
|
||||
|
||||
(defn compare=
|
||||
"Equivalent of '=' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce = xs))
|
||||
|
||||
(defn compare<
|
||||
"Equivalent of '<' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce < xs))
|
||||
|
||||
(defn compare<=
|
||||
"Equivalent of '<=' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce <= xs))
|
||||
|
||||
(defn compare>
|
||||
"Equivalent of '>' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce > xs))
|
||||
|
||||
(defn compare>=
|
||||
"Equivalent of '>=' but using compare function instead of primitive comparator"
|
||||
[& xs]
|
||||
(compare-reduce >= xs))
|
||||
|
||||
(put _env 'compare-reduce nil)
|
||||
|
||||
###
|
||||
###
|
||||
### Indexed Combinators
|
||||
@@ -910,9 +843,8 @@
|
||||
arr)
|
||||
3 (do
|
||||
(def [n m s] args)
|
||||
(cond
|
||||
(zero? s) @[]
|
||||
(neg? s) (seq [i :down [n m (- s)]] i)
|
||||
(if (neg? s)
|
||||
(seq [i :down [n m (- s)]] i)
|
||||
(seq [i :range [n m s]] i)))
|
||||
(error "expected 1 to 3 arguments to range")))
|
||||
|
||||
@@ -1008,21 +940,6 @@
|
||||
(array/push parts (tuple apply f $args)))
|
||||
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
|
||||
|
||||
(defmacro tracev
|
||||
"Print a value and a description of the form that produced that value to
|
||||
stderr. Evaluates to x."
|
||||
[x]
|
||||
(def [l c] (tuple/sourcemap (dyn :macro-form ())))
|
||||
(def cf (dyn :current-file))
|
||||
(def fmt-1 (if cf (string/format "trace [%s]" cf) "trace"))
|
||||
(def fmt-2 (if (or (neg? l) (neg? c)) ":" (string/format " on line %d, column %d:" l c)))
|
||||
(def fmt (string fmt-1 fmt-2 " %j is "))
|
||||
(def s (gensym))
|
||||
~(let [,s ,x]
|
||||
(,eprinf ,fmt ',x)
|
||||
(,eprintf (,dyn :pretty-format "%q") ,s)
|
||||
,s))
|
||||
|
||||
(defmacro ->
|
||||
"Threading macro. Inserts x as the second value in the first form
|
||||
in forms, and inserts the modified first form into the second form
|
||||
@@ -1490,9 +1407,9 @@
|
||||
~(do (def ,pattern ,expr) ,(onmatch))))
|
||||
|
||||
(and (tuple? pattern) (= :parens (tuple/type pattern)))
|
||||
(if (= (get pattern 0) '@)
|
||||
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
|
||||
# Unification with external values
|
||||
~(if (= ,(get pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||
~(if (= ,(pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||
(match-1
|
||||
(in pattern 0) expr
|
||||
(fn []
|
||||
@@ -1774,7 +1691,7 @@
|
||||
(def m? (entry :macro))
|
||||
(cond
|
||||
s (s t)
|
||||
m? (do (setdyn :macro-form t) (m ;(tuple/slice t 1)))
|
||||
m? (m ;(tuple/slice t 1))
|
||||
(tuple/slice (map recur t))))
|
||||
|
||||
(def ret
|
||||
@@ -2034,7 +1951,6 @@
|
||||
(default on-parse-error bad-parse)
|
||||
(default evaluator (fn evaluate [x &] (x)))
|
||||
(default where "<anonymous>")
|
||||
(default guard :ydt)
|
||||
|
||||
# Are we done yet?
|
||||
(var going true)
|
||||
@@ -2061,31 +1977,18 @@
|
||||
(string err " on line " line ", column " column)
|
||||
err))
|
||||
(on-compile-error msg errf where))))
|
||||
guard))
|
||||
(or guard :a)))
|
||||
(fiber/setenv f env)
|
||||
(while (fiber/can-resume? f)
|
||||
(def res (resume f resumeval))
|
||||
(when good (when going (set resumeval (onstatus f res))))))
|
||||
|
||||
(defn parse-err
|
||||
"Handle parser error in the correct environment"
|
||||
[p where]
|
||||
(def f (coro (on-parse-error p where)))
|
||||
(fiber/setenv f env)
|
||||
(resume f))
|
||||
|
||||
# Loop
|
||||
(def buf @"")
|
||||
(while going
|
||||
(if (env :exit) (break))
|
||||
(buffer/clear buf)
|
||||
(if (= (chunks buf p)
|
||||
:cancel)
|
||||
(do
|
||||
# A :cancel chunk represents a cancelled form in the REPL, so reset.
|
||||
(parser/flush p)
|
||||
(buffer/clear buf))
|
||||
(do
|
||||
(chunks buf p)
|
||||
(var pindex 0)
|
||||
(var pstatus nil)
|
||||
(def len (length buf))
|
||||
@@ -2097,13 +2000,12 @@
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(parse-err p where))))))
|
||||
|
||||
(on-parse-error p where))))
|
||||
# Check final parser state
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(parse-err p where))
|
||||
(on-parse-error p where))
|
||||
|
||||
(in env :exit-value env))
|
||||
|
||||
@@ -2150,19 +2052,6 @@
|
||||
(res)
|
||||
(error (res :error))))
|
||||
|
||||
(defn parse
|
||||
"Parse a string and return the first value. For complex parsing, such as for a repl with error handling,
|
||||
use the parser api."
|
||||
[str]
|
||||
(let [p (parser/new)]
|
||||
(parser/consume p str)
|
||||
(parser/eof p)
|
||||
(if (parser/has-more p)
|
||||
(parser/produce p)
|
||||
(if (= :error (parser/status p))
|
||||
(error (parser/error p))
|
||||
(error "no value")))))
|
||||
|
||||
(def make-image-dict
|
||||
"A table used in combination with marshal to marshal code (images), such that
|
||||
(make-image x) is the same as (marshal x make-image-dict)."
|
||||
@@ -2216,12 +2105,11 @@
|
||||
(defn- find-prefix
|
||||
[pre]
|
||||
(or (find-index |(and (string? ($ 0)) (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-.])
|
||||
(def curall-index (find-prefix ":cur:/:all:"))
|
||||
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-.])
|
||||
module/paths)
|
||||
|
||||
(module/add-paths ":native:" :native)
|
||||
@@ -2348,11 +2236,14 @@
|
||||
newenv)
|
||||
:image (fn [path &] (load-image (slurp path)))})
|
||||
|
||||
(defn require-1
|
||||
[path args kargs]
|
||||
(defn require
|
||||
"Require a module with the given name. Will search all of the paths in
|
||||
module/paths. Returns the new environment
|
||||
returned from compiling and running the file."
|
||||
[path & args]
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
(if-let [check (if-not (kargs :fresh) (in module/cache fullpath))]
|
||||
(if-let [check (in module/cache fullpath)]
|
||||
check
|
||||
(if (module/loading fullpath)
|
||||
(error (string "circular dependency " fullpath " detected"))
|
||||
@@ -2363,23 +2254,15 @@
|
||||
(put module/cache fullpath env)
|
||||
env))))
|
||||
|
||||
(defn require
|
||||
"Require a module with the given name. Will search all of the paths in
|
||||
module/paths. Returns the new environment
|
||||
returned from compiling and running the file."
|
||||
[path & args]
|
||||
(require-1 path args (struct ;args)))
|
||||
|
||||
(defn import*
|
||||
"Function form of import. Same parameters, but the path
|
||||
and other symbol parameters should be strings instead."
|
||||
[path & args]
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def kargs (table ;args))
|
||||
(def {:as as
|
||||
:prefix prefix
|
||||
:export ep} kargs)
|
||||
(def newenv (require-1 path args kargs))
|
||||
:export ep} (table ;args))
|
||||
(def newenv (require path ;args))
|
||||
(def prefix (or
|
||||
(and as (string as "/"))
|
||||
prefix
|
||||
@@ -2388,8 +2271,6 @@
|
||||
(def newv (table/setproto @{:private (not ep)} v))
|
||||
(put env (symbol prefix k) newv)))
|
||||
|
||||
(put _env 'require-1 nil)
|
||||
|
||||
(defmacro import
|
||||
"Import a module. First requires the module, and then merges its
|
||||
symbols into the current environment, prepending a given prefix as needed.
|
||||
@@ -2397,8 +2278,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. Dynamic bindings will NOT be imported. Use :fresh to bypass the
|
||||
module cache."
|
||||
to be called. Dynamic bindings will NOT be imported."
|
||||
[path & args]
|
||||
(def argm (map |(if (keyword? $) $ (string $)) args))
|
||||
(tuple import* (string path) ;argm))
|
||||
@@ -2453,34 +2333,31 @@
|
||||
[&opt nth frame-idx]
|
||||
(in (.slots frame-idx) (or nth 0)))
|
||||
|
||||
# Conditional compilation for disasm
|
||||
(def disasm-alias (if-let [x (_env 'disasm)] (x :value)))
|
||||
|
||||
(defn .disasm
|
||||
"Gets the assembly for the current function."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(disasm-alias func))
|
||||
(disasm func))
|
||||
|
||||
(defn .bytecode
|
||||
"Get the bytecode for the current function."
|
||||
[&opt n]
|
||||
((.disasm n) :bytecode))
|
||||
((.disasm n) 'bytecode))
|
||||
|
||||
(defn .ppasm
|
||||
"Pretty prints the assembly for the current function"
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(def dasm (disasm-alias func))
|
||||
(def bytecode (in dasm :bytecode))
|
||||
(def dasm (disasm func))
|
||||
(def bytecode (dasm 'bytecode))
|
||||
(def pc (frame :pc))
|
||||
(def sourcemap (in dasm :sourcemap))
|
||||
(def sourcemap (dasm 'sourcemap))
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n signal: " (.signal))
|
||||
(print " function: " (dasm :name) " [" (in dasm :source "") "]")
|
||||
(when-let [constants (dasm :constants)]
|
||||
(print " function: " (dasm 'name) " [" (in dasm 'source "") "]")
|
||||
(when-let [constants (dasm 'constants)]
|
||||
(printf " constants: %.4q" constants))
|
||||
(printf " slots: %.4q\n" (frame :slots))
|
||||
(def padding (string/repeat " " 20))
|
||||
@@ -2498,6 +2375,14 @@
|
||||
(print))
|
||||
(print))
|
||||
|
||||
(defn .source
|
||||
"Show the source code for the function being debugged."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def s (frame :source))
|
||||
(def all-source (slurp s))
|
||||
(print "\n" all-source "\n"))
|
||||
|
||||
(defn .breakall
|
||||
"Set breakpoints on all instructions in the current function."
|
||||
[&opt n]
|
||||
@@ -2516,22 +2401,6 @@
|
||||
(debug/unfbreak fun i))
|
||||
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(unless (get _env 'disasm)
|
||||
(put _env '.disasm nil)
|
||||
(put _env '.bytecode nil)
|
||||
(put _env '.breakall nil)
|
||||
(put _env '.clearall nil)
|
||||
(put _env '.ppasm nil))
|
||||
(put _env 'disasm-alias nil)
|
||||
|
||||
(defn .source
|
||||
"Show the source code for the function being debugged."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def s (frame :source))
|
||||
(def all-source (slurp s))
|
||||
(print "\n" all-source "\n"))
|
||||
|
||||
(defn .break
|
||||
"Set breakpoint at the current pc."
|
||||
[]
|
||||
@@ -2572,11 +2441,8 @@
|
||||
(set res (debug/step (.fiber))))
|
||||
res)
|
||||
|
||||
(def debugger-env
|
||||
"An environment that contains dot prefixed functions for debugging."
|
||||
@{})
|
||||
|
||||
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
|
||||
(def- debugger-env @{})
|
||||
(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
|
||||
(put _env 'debugger-keys nil)
|
||||
|
||||
@@ -2629,19 +2495,19 @@
|
||||
|
||||
(fn [f x]
|
||||
(if (= :dead (fiber/status f))
|
||||
(do
|
||||
(put e '_ @{:value x})
|
||||
(printf (get e :pretty-format "%q") x)
|
||||
(flush))
|
||||
(if (e :debug)
|
||||
(enter-debugger f x)
|
||||
(do (debug/stacktrace f x) (eflush))))))
|
||||
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:expander (fn [x] [pp x])
|
||||
:on-status (or onsignal (make-onsignal env 1))
|
||||
:source "repl"}))
|
||||
|
||||
(put _env 'debugger-env nil)
|
||||
|
||||
###
|
||||
###
|
||||
### CLI Tool Main
|
||||
@@ -2669,12 +2535,7 @@
|
||||
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
|
||||
'defglobal is-safe-def 'varglobal is-safe-def})
|
||||
|
||||
(def- importers {'import true 'import* true 'dofile true 'require true})
|
||||
(defn- use-2 [evaluator args]
|
||||
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
|
||||
|
||||
# conditional compilation for reduced os
|
||||
(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&])))
|
||||
(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
|
||||
|
||||
(defn cli-main
|
||||
"Entrance for the Janet CLI tool. Call this functions with the command line
|
||||
@@ -2693,8 +2554,8 @@
|
||||
(var *debug* false)
|
||||
(var *compile-only* false)
|
||||
|
||||
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
|
||||
(if-let [jp (getenv-alias "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
|
||||
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
|
||||
# Flag handlers
|
||||
(def handlers
|
||||
@@ -2709,7 +2570,7 @@
|
||||
-d : Set the debug flag in the repl
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide logo (quiet)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
@@ -2759,9 +2620,6 @@
|
||||
# Always safe form
|
||||
safe-check
|
||||
(thunk)
|
||||
# Use
|
||||
(= 'use head)
|
||||
(use-2 evaluator (tuple/slice source 1))
|
||||
# Import-like form
|
||||
(importers head)
|
||||
(do
|
||||
@@ -2804,16 +2662,16 @@
|
||||
(def getter (if *raw-stdin* getstdin getline))
|
||||
(defn getchunk [buf p]
|
||||
(getter (getprompt 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 nil env)))
|
||||
(repl getchunk onsig env)))
|
||||
|
||||
(put _env 'no-side-effects nil)
|
||||
(put _env 'is-safe-def nil)
|
||||
(put _env 'safe-forms nil)
|
||||
(put _env 'importers nil)
|
||||
(put _env 'use-2 nil)
|
||||
(put _env 'getenv-alias nil)
|
||||
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2900,7 +2758,6 @@
|
||||
"src/core/io.c"
|
||||
"src/core/marsh.c"
|
||||
"src/core/math.c"
|
||||
"src/core/net.c"
|
||||
"src/core/os.c"
|
||||
"src/core/parse.c"
|
||||
"src/core/peg.c"
|
||||
@@ -2942,14 +2799,6 @@
|
||||
(each h local-headers
|
||||
(do-one-file h))
|
||||
|
||||
# windows.h should not be included in any of the external or internal headers - only in .c files.
|
||||
(print)
|
||||
(print "/* Windows work around - winsock2 must be included before windows.h, especially in amalgamated build */")
|
||||
(print "#if defined(JANET_WINDOWS) && defined(JANET_NET)")
|
||||
(print "#include <winsock2.h>")
|
||||
(print "#endif")
|
||||
(print)
|
||||
|
||||
(each s core-sources
|
||||
(do-one-file s))
|
||||
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 10
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_MINOR 9
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.10.1"
|
||||
#define JANET_VERSION "1.9.0-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -45,22 +45,14 @@
|
||||
/* #define JANET_NO_DOCSTRINGS */
|
||||
/* #define JANET_NO_SOURCEMAPS */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
/* #define JANET_NO_PROCESSES */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_PRF */
|
||||
/* #define JANET_NO_UTC_MKTIME */
|
||||
/* #define JANET_NO_REALPATH */
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
||||
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
|
||||
@@ -270,26 +270,6 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (array->count) {
|
||||
if (array->count < array->capacity) {
|
||||
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
array->data = newData;
|
||||
array->capacity = array->count;
|
||||
}
|
||||
} else {
|
||||
array->capacity = 0;
|
||||
free(array->data);
|
||||
array->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{
|
||||
"array/new", cfun_array_new,
|
||||
@@ -365,11 +345,6 @@ static const JanetReg array_cfuns[] = {
|
||||
"By default, n is 1. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{
|
||||
"array/trim", cfun_array_trim,
|
||||
JDOC("(array/trim arr)\n\n"
|
||||
"Set the backing capacity of an array to its current length. Returns the modified array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -53,6 +53,7 @@ struct JanetAssembler {
|
||||
|
||||
Janet name;
|
||||
JanetTable labels; /* keyword -> bytecode index */
|
||||
JanetTable constants; /* symbol -> constant index */
|
||||
JanetTable slots; /* symbol -> slot index */
|
||||
JanetTable envs; /* symbol -> environment index */
|
||||
JanetTable defs; /* symbol -> funcdefs index */
|
||||
@@ -171,6 +172,7 @@ static void janet_asm_deinit(JanetAssembler *a) {
|
||||
janet_table_deinit(&a->slots);
|
||||
janet_table_deinit(&a->labels);
|
||||
janet_table_deinit(&a->envs);
|
||||
janet_table_deinit(&a->constants);
|
||||
janet_table_deinit(&a->defs);
|
||||
}
|
||||
|
||||
@@ -250,6 +252,9 @@ static int32_t doarg_1(
|
||||
case JANET_OAT_ENVIRONMENT:
|
||||
c = &a->envs;
|
||||
break;
|
||||
case JANET_OAT_CONSTANT:
|
||||
c = &a->constants;
|
||||
break;
|
||||
case JANET_OAT_LABEL:
|
||||
c = &a->labels;
|
||||
break;
|
||||
@@ -501,6 +506,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.defs_capacity = 0;
|
||||
a.name = janet_wrap_nil();
|
||||
janet_table_init(&a.labels, 0);
|
||||
janet_table_init(&a.constants, 0);
|
||||
janet_table_init(&a.slots, 0);
|
||||
janet_table_init(&a.envs, 0);
|
||||
janet_table_init(&a.defs, 0);
|
||||
@@ -528,34 +534,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
"expected struct or table for assembly source");
|
||||
|
||||
/* Check for function name */
|
||||
a.name = janet_get1(s, janet_ckeywordv("name"));
|
||||
a.name = janet_get1(s, janet_csymbolv("name"));
|
||||
if (!janet_checktype(a.name, JANET_NIL)) {
|
||||
def->name = janet_to_string(a.name);
|
||||
}
|
||||
|
||||
/* Set function arity */
|
||||
x = janet_get1(s, janet_ckeywordv("arity"));
|
||||
x = janet_get1(s, janet_csymbolv("arity"));
|
||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
|
||||
|
||||
x = janet_get1(s, janet_ckeywordv("max-arity"));
|
||||
x = janet_get1(s, janet_csymbolv("max-arity"));
|
||||
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
|
||||
|
||||
x = janet_get1(s, janet_ckeywordv("min-arity"));
|
||||
x = janet_get1(s, janet_csymbolv("min-arity"));
|
||||
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
|
||||
|
||||
/* Check vararg */
|
||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Check source */
|
||||
x = janet_get1(s, janet_ckeywordv("source"));
|
||||
x = janet_get1(s, janet_csymbolv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
|
||||
/* Create slot aliases */
|
||||
x = janet_get1(s, janet_ckeywordv("slots"));
|
||||
x = janet_get1(s, janet_csymbolv("slots"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet v = arr[i];
|
||||
@@ -576,7 +582,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse constants */
|
||||
x = janet_get1(s, janet_ckeywordv("constants"));
|
||||
x = janet_get1(s, janet_csymbolv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = malloc(sizeof(Janet) * (size_t) count);
|
||||
@@ -585,15 +591,33 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet ct = arr[i];
|
||||
if (janet_checktype(ct, JANET_TUPLE) &&
|
||||
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
|
||||
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
|
||||
const Janet *t = janet_unwrap_tuple(ct);
|
||||
int32_t tcount = janet_tuple_length(t);
|
||||
const uint8_t *macro = janet_unwrap_symbol(t[0]);
|
||||
if (0 == janet_cstrcmp(macro, "quote")) {
|
||||
def->constants[i] = t[1];
|
||||
} else if (tcount == 3 &&
|
||||
janet_checktype(t[1], JANET_SYMBOL) &&
|
||||
0 == janet_cstrcmp(macro, "def")) {
|
||||
def->constants[i] = t[2];
|
||||
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
|
||||
} else {
|
||||
janet_asm_errorv(&a, janet_formatc("could not parse constant \"%v\"", ct));
|
||||
}
|
||||
} else {
|
||||
def->constants[i] = ct;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
def->constants = NULL;
|
||||
def->constants_length = 0;
|
||||
}
|
||||
|
||||
/* Parse sub funcdefs */
|
||||
x = janet_get1(s, janet_ckeywordv("closures"));
|
||||
x = janet_get1(s, janet_csymbolv("closures"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
@@ -604,7 +628,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (subres.status != JANET_ASSEMBLE_OK) {
|
||||
janet_asm_errorv(&a, subres.error);
|
||||
}
|
||||
subname = janet_get1(arr[i], janet_ckeywordv("name"));
|
||||
subname = janet_get1(arr[i], janet_csymbolv("name"));
|
||||
if (!janet_checktype(subname, JANET_NIL)) {
|
||||
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
|
||||
}
|
||||
@@ -623,7 +647,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse bytecode and labels */
|
||||
x = janet_get1(s, janet_ckeywordv("bytecode"));
|
||||
x = janet_get1(s, janet_csymbolv("bytecode"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
/* Do labels and find length */
|
||||
int32_t blength = 0;
|
||||
@@ -679,7 +703,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.errindex = -1;
|
||||
|
||||
/* Check for source mapping */
|
||||
x = janet_get1(s, janet_ckeywordv("sourcemap"));
|
||||
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) * (size_t) count);
|
||||
@@ -840,26 +864,33 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
JanetArray *constants;
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_ckeywordv("arity"), janet_wrap_integer(def->arity));
|
||||
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_wrap_array(bcode));
|
||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
||||
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||
if (NULL != def->source) {
|
||||
janet_table_put(ret, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_wrap_true());
|
||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||
}
|
||||
if (NULL != def->name) {
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_wrap_string(def->name));
|
||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
|
||||
/* Add constants */
|
||||
if (def->constants_length > 0) {
|
||||
constants = janet_array(def->constants_length);
|
||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_wrap_array(constants));
|
||||
janet_table_put(ret, janet_csymbolv("constants"), janet_wrap_array(constants));
|
||||
for (i = 0; i < def->constants_length; i++) {
|
||||
constants->data[i] = def->constants[i];
|
||||
Janet src = def->constants[i];
|
||||
Janet dest;
|
||||
if (janet_checktype(src, JANET_TUPLE)) {
|
||||
dest = janet_wrap_tuple(tup2(janet_csymbolv("quote"), src));
|
||||
} else {
|
||||
dest = src;
|
||||
}
|
||||
constants->data[i] = dest;
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
}
|
||||
@@ -881,7 +912,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_wrap_array(sourcemap));
|
||||
janet_table_put(ret, janet_csymbolv("sourcemap"), janet_wrap_array(sourcemap));
|
||||
}
|
||||
|
||||
/* Add environments */
|
||||
@@ -891,7 +922,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_wrap_array(envs));
|
||||
janet_table_put(ret, janet_csymbolv("environments"), janet_wrap_array(envs));
|
||||
}
|
||||
|
||||
/* Add closures */
|
||||
@@ -902,11 +933,11 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
janet_table_put(ret, janet_ckeywordv("defs"), janet_wrap_array(defs));
|
||||
janet_table_put(ret, janet_csymbolv("defs"), janet_wrap_array(defs));
|
||||
}
|
||||
|
||||
/* Add slotcount */
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_wrap_integer(def->slotcount));
|
||||
janet_table_put(ret, janet_csymbolv("slotcount"), janet_wrap_integer(def->slotcount));
|
||||
|
||||
return janet_wrap_struct(janet_table_to_struct(ret));
|
||||
}
|
||||
@@ -933,7 +964,7 @@ static const JanetReg asm_cfuns[] = {
|
||||
"asm", cfun_asm,
|
||||
JDOC("(asm assembly)\n\n"
|
||||
"Returns a new function that is the compiled result of the assembly.\n"
|
||||
"The syntax for the assembly can be found on the Janet website. Will throw an\n"
|
||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -197,26 +197,6 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count) {
|
||||
if (buffer->count < buffer->capacity) {
|
||||
uint8_t *newData = realloc(buffer->data, buffer->count);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
buffer->data = newData;
|
||||
buffer->capacity = buffer->count;
|
||||
}
|
||||
} else {
|
||||
buffer->capacity = 0;
|
||||
free(buffer->data);
|
||||
buffer->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -399,12 +379,6 @@ static const JanetReg buffer_cfuns[] = {
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
"Returns the modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/trim", cfun_buffer_trim,
|
||||
JDOC("(buffer/trim buffer)\n\n"
|
||||
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
|
||||
"modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
|
||||
@@ -27,15 +27,6 @@
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
#else
|
||||
fputs(msg, stdout);
|
||||
exit(1);
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
@@ -46,8 +37,8 @@ void janet_signalv(JanetSignal sig, Janet message) {
|
||||
longjmp(*janet_vm_jmp_buf, sig);
|
||||
#endif
|
||||
} else {
|
||||
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
||||
janet_top_level_signal(str);
|
||||
fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -596,11 +596,8 @@ static int macroexpand1(
|
||||
/* Set env */
|
||||
fiberp->env = c->env;
|
||||
int lock = janet_gclock();
|
||||
Janet mf_kw = janet_ckeywordv("macro-form");
|
||||
janet_table_put(c->env, mf_kw, x);
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
@@ -750,10 +747,8 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
/* Copy upvalue bitset */
|
||||
if (scope->ua.count) {
|
||||
/* Number of u32s we need to create a bitmask for all slots */
|
||||
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
||||
/* numchunks is min of slotchunks and scope->ua.count */
|
||||
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
||||
uint32_t *chunks = calloc(sizeof(uint32_t), slotchunks);
|
||||
int32_t numchunks = (def->slotcount + 31) >> 5;
|
||||
uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
|
||||
if (NULL == chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -860,10 +855,10 @@ static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a new function and does not modify ast. Returns an error "
|
||||
"struct with keys :line, :column, and :error if compilation fails.")
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -643,8 +643,8 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
JDOC("(hash value)\n\n"
|
||||
"Gets a hash for any value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all values. If two values are strictly equal, "
|
||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"then they will have the same hash value.")
|
||||
},
|
||||
{
|
||||
@@ -685,9 +685,9 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:all:\tthe value of path verbatim\n"
|
||||
"\t:cur:\tthe current file, or (dyn :current-file)\n"
|
||||
"\t:dir:\tthe directory containing the current file\n"
|
||||
"\t:name:\tthe name component of path, with extension if given\n"
|
||||
"\t:name:\tthe filename component of path, with extension if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (dyn :syspath)")
|
||||
"\t:sys:\tthe system path, or (syn :syspath)")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
@@ -742,7 +742,7 @@ static void janet_quick_asm(
|
||||
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
|
||||
}
|
||||
|
||||
/* Macros for easier inline assembly */
|
||||
/* Macros for easier inline janet assembly */
|
||||
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
|
||||
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
|
||||
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
|
||||
@@ -1004,9 +1004,6 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_lib_net(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
@@ -1035,8 +1032,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"Propagate a signal from a fiber to the current fiber. The resulting "
|
||||
"stack trace from the current fiber will include frames from fiber. If "
|
||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||
"first resume fiber. This function can be used to re-raise an error without "
|
||||
"losing the original stack trace."));
|
||||
"first resume fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
@@ -1108,7 +1104,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
"values. Division by two integers uses truncating division."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
|
||||
@@ -26,11 +26,7 @@
|
||||
#define JANET_FEATURES_H_defined
|
||||
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200809L
|
||||
#endif
|
||||
|
||||
#if defined(WIN32) || defined(_WIN32)
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
/* Needed for realpath on linux */
|
||||
|
||||
@@ -405,10 +405,6 @@ JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm_fiber;
|
||||
}
|
||||
|
||||
JanetFiber *janet_root_fiber(void) {
|
||||
return janet_vm_root_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
@@ -512,12 +508,6 @@ static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_root_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
@@ -585,12 +575,6 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||
"\t:new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{
|
||||
"fiber/root", cfun_fiber_root,
|
||||
JDOC("(fiber/root)\n\n"
|
||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||
"that does not have a parent.")
|
||||
},
|
||||
{
|
||||
"fiber/current", cfun_fiber_current,
|
||||
JDOC("(fiber/current)\n\n"
|
||||
|
||||
@@ -389,9 +389,6 @@ void janet_collect(void) {
|
||||
if (janet_vm_gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
orig_rootcount = janet_vm_root_count;
|
||||
#ifdef JANET_NET
|
||||
janet_net_markloop();
|
||||
#endif
|
||||
for (i = 0; i < orig_rootcount; i++)
|
||||
janet_mark(janet_vm_roots[i]);
|
||||
while (orig_rootcount < janet_vm_root_count) {
|
||||
@@ -533,7 +530,7 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
JANET_EXIT("invalid janet_srealloc");
|
||||
janet_exit("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
@@ -554,5 +551,5 @@ void janet_sfree(void *mem) {
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
JANET_EXIT("invalid janet_sfree");
|
||||
janet_exit("invalid janet_sfree");
|
||||
}
|
||||
|
||||
@@ -197,122 +197,6 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
// Code to support polymorphic comparison.
|
||||
//
|
||||
// int/u64 and int/s64 support a "compare" method that allows
|
||||
// comparison to each other, and to Janet numbers, using the
|
||||
// "compare" "compare<" ... functions.
|
||||
//
|
||||
// In the following code explicit casts are sometimes used to help
|
||||
// make it clear when int/float conversions are happening.
|
||||
//
|
||||
static int compare_double_double(double x, double y) {
|
||||
return (x < y) ? -1 : ((x > y) ? 1 : 0);
|
||||
}
|
||||
|
||||
static int compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
return -1;
|
||||
} else if (y < ((double) INT64_MIN)) {
|
||||
return 1;
|
||||
} else {
|
||||
int64_t yi = (int64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
static int compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if (y < 0) {
|
||||
return 1;
|
||||
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) UINT64_MAX)) {
|
||||
return -1;
|
||||
} else {
|
||||
uint64_t yi = (uint64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
int64_t x = janet_unwrap_s64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_int64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
int64_t y = *(int64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
// comparing signed to unsigned -- be careful!
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
if (x < 0) {
|
||||
return janet_wrap_number(-1);
|
||||
} else if (y > INT64_MAX) {
|
||||
return janet_wrap_number(-1);
|
||||
} else {
|
||||
int64_t y2 = (int64_t) y;
|
||||
return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_uint64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
// comparing unsigned to signed -- be careful!
|
||||
int64_t y = *(int64_t *)abst;
|
||||
if (y < 0) {
|
||||
return janet_wrap_number(1);
|
||||
} else if (x > INT64_MAX) {
|
||||
return janet_wrap_number(1);
|
||||
} else {
|
||||
int64_t x2 = (int64_t) x;
|
||||
return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
@@ -382,6 +266,14 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T v1 = janet_unwrap_##type(argv[0]); \
|
||||
T v2 = janet_unwrap_##type(argv[1]); \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
@@ -424,6 +316,13 @@ OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
COMPMETHOD(int64_t, s64, lt, <)
|
||||
COMPMETHOD(int64_t, s64, gt, >)
|
||||
COMPMETHOD(int64_t, s64, le, <=)
|
||||
COMPMETHOD(int64_t, s64, ge, >=)
|
||||
COMPMETHOD(int64_t, s64, eq, ==)
|
||||
COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
@@ -437,13 +336,18 @@ OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
COMPMETHOD(uint64_t, u64, lt, <)
|
||||
COMPMETHOD(uint64_t, u64, gt, >)
|
||||
COMPMETHOD(uint64_t, u64, le, <=)
|
||||
COMPMETHOD(uint64_t, u64, ge, >=)
|
||||
COMPMETHOD(uint64_t, u64, eq, ==)
|
||||
COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
#undef OPMETHOD
|
||||
#undef DIVMETHOD
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
@@ -457,6 +361,12 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"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_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
@@ -465,7 +375,6 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
@@ -483,6 +392,12 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"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_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
@@ -491,7 +406,6 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -30,9 +30,7 @@
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <fcntl.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
@@ -89,17 +87,18 @@ static Janet makef(FILE *f, int flags) {
|
||||
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
|
||||
iof->file = f;
|
||||
iof->flags = flags;
|
||||
#ifndef JANET_WINDOWS
|
||||
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
|
||||
* not standard. */
|
||||
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
|
||||
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
|
||||
#endif
|
||||
return janet_wrap_abstract(iof);
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
#ifdef __EMSCRIPTEN__
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not implemented on this platform");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#else
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
@@ -130,7 +129,6 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
FILE *tmp = tmpfile();
|
||||
if (!tmp)
|
||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
||||
@@ -241,24 +239,12 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
|
||||
/* Cleanup a file */
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
/* We can't panic inside a gc, so just ignore bad statuses here */
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
pclose(iof->file);
|
||||
#endif
|
||||
} else {
|
||||
fclose(iof->file);
|
||||
}
|
||||
return fclose(iof->file);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -272,17 +258,16 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
#endif
|
||||
} else {
|
||||
if (fclose(iof->file)) {
|
||||
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
||||
janet_panic("could not close file");
|
||||
}
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -655,7 +640,6 @@ static const JanetReg io_cfuns[] = {
|
||||
"for the relative number of bytes to seek in the file. n may be a real "
|
||||
"number to handle large files of more the 4GB. Returns the file handle.")
|
||||
},
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path &opt mode)\n\n"
|
||||
@@ -664,7 +648,6 @@ static const JanetReg io_cfuns[] = {
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -1417,17 +1417,17 @@ static const JanetReg marsh_cfuns[] = {
|
||||
{
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the original value when "
|
||||
"lookup table can be used to recover the original janet value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||
"Unmarshal a value from a buffer. An optional lookup table "
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.")
|
||||
},
|
||||
|
||||
@@ -413,7 +413,7 @@ static const JanetReg math_cfuns[] = {
|
||||
"math/rng", cfun_rng_make,
|
||||
JDOC("(math/rng &opt seed)\n\n"
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"The seed should be an unsigned 32 bit integer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type.")
|
||||
},
|
||||
{
|
||||
@@ -480,7 +480,7 @@ static const JanetReg math_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"math/next", janet_nextafter,
|
||||
JDOC("(math/next x y)\n\n"
|
||||
JDOC("(math/next y)\n\n"
|
||||
"Returns the next representable floating point value after x in the direction of y.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
|
||||
681
src/core/net.c
681
src/core/net.c
@@ -1,681 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NET
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <winsock2.h>
|
||||
#include <windows.h>
|
||||
#include <ws2tcpip.h>
|
||||
#pragma comment (lib, "Ws2_32.lib")
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <signal.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <poll.h>
|
||||
#include <netdb.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Streams
|
||||
*/
|
||||
|
||||
#define JANET_STREAM_CLOSED 1
|
||||
#define JANET_STREAM_READABLE 2
|
||||
#define JANET_STREAM_WRITABLE 4
|
||||
|
||||
static int janet_stream_close(void *p, size_t s);
|
||||
static int janet_stream_getter(void *p, Janet key, Janet *out);
|
||||
static const JanetAbstractType StreamAT = {
|
||||
"core/stream",
|
||||
janet_stream_close,
|
||||
NULL,
|
||||
janet_stream_getter,
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef struct {
|
||||
SOCKET fd;
|
||||
int flags;
|
||||
} JanetStream;
|
||||
#define JSOCKCLOSE(x) closesocket(x)
|
||||
#define JSOCKDEFAULT INVALID_SOCKET
|
||||
#define JLASTERR WSAGetLastError()
|
||||
#define JSOCKVALID(x) ((x) != INVALID_SOCKET)
|
||||
#define JEINTR WSAEINTR
|
||||
#define JEWOULDBLOCK WSAEWOULDBLOCK
|
||||
#define JEAGAIN WSAEWOULDBLOCK
|
||||
#define JPOLL WSAPoll
|
||||
#define JPollStruct WSAPOLLFD
|
||||
#define JSock SOCKET
|
||||
#define JReadInt long
|
||||
#define JSOCKFLAGS 0
|
||||
static JanetStream *make_stream(SOCKET fd, int flags) {
|
||||
u_long iMode = 0;
|
||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||
ioctlsocket(fd, FIONBIO, &iMode);
|
||||
stream->fd = fd;
|
||||
stream->flags = flags;
|
||||
return stream;
|
||||
}
|
||||
#else
|
||||
typedef struct {
|
||||
int fd;
|
||||
int flags;
|
||||
} JanetStream;
|
||||
#define JSOCKCLOSE(x) close(x)
|
||||
#define JSOCKDEFAULT 0
|
||||
#define JLASTERR errno
|
||||
#define JSOCKVALID(x) ((x) >= 0)
|
||||
#define JEINTR EINTR
|
||||
#define JEWOULDBLOCK EWOULDBLOCK
|
||||
#define JEAGAIN EAGAIN
|
||||
#define JPOLL poll
|
||||
#define JPollStruct struct pollfd
|
||||
#define JSock int
|
||||
#define JReadInt ssize_t
|
||||
#ifdef SOCK_CLOEXEC
|
||||
#define JSOCKFLAGS SOCK_CLOEXEC
|
||||
#else
|
||||
#define JSOCKFLAGS 0
|
||||
#endif
|
||||
static JanetStream *make_stream(int fd, int flags) {
|
||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||
#ifndef SOCK_CLOEXEC
|
||||
int extra = O_CLOEXEC;
|
||||
#else
|
||||
int extra = 0;
|
||||
#endif
|
||||
fcntl(fd, F_SETFL, fcntl(fd, F_GETFL, 0) | O_NONBLOCK | extra);
|
||||
stream->fd = fd;
|
||||
stream->flags = flags;
|
||||
return stream;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* We pass this flag to all send calls to prevent sigpipe */
|
||||
#ifndef MSG_NOSIGNAL
|
||||
#define MSG_NOSIGNAL 0
|
||||
#endif
|
||||
|
||||
static int janet_stream_close(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetStream *stream = p;
|
||||
if (!(stream->flags & JANET_STREAM_CLOSED)) {
|
||||
stream->flags |= JANET_STREAM_CLOSED;
|
||||
JSOCKCLOSE(stream->fd);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Event loop
|
||||
*/
|
||||
|
||||
/* This large struct describes a waiting file descriptor, as well
|
||||
* as what to do when we get an event for it. It is a variant type, where
|
||||
* each variant implements a simple state machine. */
|
||||
typedef struct {
|
||||
|
||||
/* File descriptor to listen for events on. */
|
||||
JanetStream *stream;
|
||||
|
||||
/* Fiber to resume when event finishes. Can be NULL, in which case,
|
||||
* no fiber is resumed when event completes. */
|
||||
JanetFiber *fiber;
|
||||
|
||||
/* What kind of event we are listening for.
|
||||
* As more IO functionality get's added, we can
|
||||
* expand this. */
|
||||
enum {
|
||||
JLE_READ_CHUNK,
|
||||
JLE_READ_SOME,
|
||||
JLE_READ_ACCEPT,
|
||||
JLE_CONNECT,
|
||||
JLE_WRITE_FROM_BUFFER,
|
||||
JLE_WRITE_FROM_STRINGLIKE
|
||||
} event_type;
|
||||
|
||||
/* Each variant can have a different payload. */
|
||||
union {
|
||||
|
||||
/* JLE_READ_CHUNK/JLE_READ_SOME */
|
||||
struct {
|
||||
int32_t bytes_left;
|
||||
JanetBuffer *buf;
|
||||
} read_chunk;
|
||||
|
||||
/* JLE_READ_ACCEPT */
|
||||
struct {
|
||||
JanetFunction *handler;
|
||||
} read_accept;
|
||||
|
||||
/* JLE_WRITE_FROM_BUFFER */
|
||||
struct {
|
||||
JanetBuffer *buf;
|
||||
int32_t start;
|
||||
} write_from_buffer;
|
||||
|
||||
/* JLE_WRITE_FROM_STRINGLIKE */
|
||||
struct {
|
||||
const uint8_t *str;
|
||||
int32_t start;
|
||||
} write_from_stringlike;
|
||||
|
||||
} data;
|
||||
|
||||
} JanetLoopFD;
|
||||
|
||||
#define JANET_LOOPFD_MAX 1024
|
||||
|
||||
/* Global loop data */
|
||||
JANET_THREAD_LOCAL JPollStruct janet_vm_pollfds[JANET_LOOPFD_MAX];
|
||||
JANET_THREAD_LOCAL JanetLoopFD janet_vm_loopfds[JANET_LOOPFD_MAX];
|
||||
JANET_THREAD_LOCAL int janet_vm_loop_count;
|
||||
|
||||
/* We could also add/remove gc roots. This is easier for now. */
|
||||
void janet_net_markloop(void) {
|
||||
for (int i = 0; i < janet_vm_loop_count; i++) {
|
||||
JanetLoopFD lfd = janet_vm_loopfds[i];
|
||||
if (lfd.fiber != NULL) {
|
||||
janet_mark(janet_wrap_fiber(lfd.fiber));
|
||||
}
|
||||
janet_mark(janet_wrap_abstract(lfd.stream));
|
||||
switch (lfd.event_type) {
|
||||
default:
|
||||
break;
|
||||
case JLE_READ_CHUNK:
|
||||
case JLE_READ_SOME:
|
||||
janet_mark(janet_wrap_buffer(lfd.data.read_chunk.buf));
|
||||
break;
|
||||
case JLE_READ_ACCEPT:
|
||||
janet_mark(janet_wrap_function(lfd.data.read_accept.handler));
|
||||
break;
|
||||
case JLE_CONNECT:
|
||||
break;
|
||||
case JLE_WRITE_FROM_BUFFER:
|
||||
janet_mark(janet_wrap_buffer(lfd.data.write_from_buffer.buf));
|
||||
break;
|
||||
case JLE_WRITE_FROM_STRINGLIKE:
|
||||
janet_mark(janet_wrap_string(lfd.data.write_from_stringlike.str));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Add a loop fd to the global event loop */
|
||||
static int janet_loop_schedule(JanetLoopFD lfd, short events) {
|
||||
if (janet_vm_loop_count == JANET_LOOPFD_MAX) {
|
||||
return -1;
|
||||
}
|
||||
int index = janet_vm_loop_count++;
|
||||
janet_vm_loopfds[index] = lfd;
|
||||
janet_vm_pollfds[index].fd = lfd.stream->fd;
|
||||
janet_vm_pollfds[index].events = events;
|
||||
janet_vm_pollfds[index].revents = 0;
|
||||
return index;
|
||||
}
|
||||
|
||||
/* Remove event from list */
|
||||
static void janet_loop_rmindex(int index) {
|
||||
janet_vm_loopfds[index] = janet_vm_loopfds[--janet_vm_loop_count];
|
||||
janet_vm_pollfds[index] = janet_vm_pollfds[janet_vm_loop_count];
|
||||
}
|
||||
|
||||
|
||||
/* Return delta in number of loop fds. Abstracted out so
|
||||
* we can separate out the polling logic */
|
||||
static size_t janet_loop_event(size_t index) {
|
||||
JanetLoopFD *jlfd = janet_vm_loopfds + index;
|
||||
JanetStream *stream = jlfd->stream;
|
||||
JSock fd = stream->fd;
|
||||
int ret = 1;
|
||||
int should_resume = 0;
|
||||
Janet resumeval = janet_wrap_nil();
|
||||
if (stream->flags & JANET_STREAM_CLOSED) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
} else {
|
||||
switch (jlfd->event_type) {
|
||||
case JLE_READ_CHUNK:
|
||||
case JLE_READ_SOME: {
|
||||
JanetBuffer *buffer = jlfd->data.read_chunk.buf;
|
||||
int32_t bytes_left = jlfd->data.read_chunk.bytes_left;
|
||||
janet_buffer_extra(buffer, bytes_left);
|
||||
if (!(stream->flags & JANET_STREAM_READABLE)) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
break;
|
||||
}
|
||||
JReadInt nread;
|
||||
do {
|
||||
nread = recv(fd, buffer->data + buffer->count, bytes_left, 0);
|
||||
} while (nread == -1 && JLASTERR == JEINTR);
|
||||
if (JLASTERR == JEAGAIN || JLASTERR == JEWOULDBLOCK) {
|
||||
ret = 1;
|
||||
break;
|
||||
}
|
||||
|
||||
if (nread > 0) {
|
||||
buffer->count += nread;
|
||||
bytes_left -= nread;
|
||||
} else {
|
||||
bytes_left = 0;
|
||||
}
|
||||
if (jlfd->event_type == JLE_READ_SOME || bytes_left == 0) {
|
||||
should_resume = 1;
|
||||
if (nread > 0) {
|
||||
resumeval = janet_wrap_buffer(buffer);
|
||||
}
|
||||
ret = 0;
|
||||
} else {
|
||||
jlfd->data.read_chunk.bytes_left = bytes_left;
|
||||
ret = 1;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JLE_READ_ACCEPT: {
|
||||
JSock connfd = accept(fd, NULL, NULL);
|
||||
if (JSOCKVALID(connfd)) {
|
||||
/* Made a new connection socket */
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
JanetFunction *handler = jlfd->data.read_accept.handler;
|
||||
Janet out;
|
||||
JanetFiber *fiberp = NULL;
|
||||
/* Launch connection fiber */
|
||||
JanetSignal sig = janet_pcall(handler, 1, &streamv, &out, &fiberp);
|
||||
if (sig != JANET_SIGNAL_OK && sig != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiberp, out);
|
||||
}
|
||||
}
|
||||
ret = JANET_LOOPFD_MAX;
|
||||
break;
|
||||
}
|
||||
case JLE_WRITE_FROM_BUFFER:
|
||||
case JLE_WRITE_FROM_STRINGLIKE: {
|
||||
int32_t start, len;
|
||||
const uint8_t *bytes;
|
||||
if (!(stream->flags & JANET_STREAM_WRITABLE)) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
break;
|
||||
}
|
||||
if (jlfd->event_type == JLE_WRITE_FROM_BUFFER) {
|
||||
JanetBuffer *buffer = jlfd->data.write_from_buffer.buf;
|
||||
bytes = buffer->data;
|
||||
len = buffer->count;
|
||||
start = jlfd->data.write_from_buffer.start;
|
||||
} else {
|
||||
bytes = jlfd->data.write_from_stringlike.str;
|
||||
len = janet_string_length(bytes);
|
||||
start = jlfd->data.write_from_stringlike.start;
|
||||
}
|
||||
if (start < len) {
|
||||
int32_t nbytes = len - start;
|
||||
JReadInt nwrote;
|
||||
do {
|
||||
nwrote = send(fd, bytes + start, nbytes, MSG_NOSIGNAL);
|
||||
} while (nwrote == -1 && JLASTERR == JEINTR);
|
||||
if (nwrote > 0) {
|
||||
start += nwrote;
|
||||
} else {
|
||||
start = len;
|
||||
}
|
||||
}
|
||||
if (start >= len) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
} else {
|
||||
if (jlfd->event_type == JLE_WRITE_FROM_BUFFER) {
|
||||
jlfd->data.write_from_buffer.start = start;
|
||||
} else {
|
||||
jlfd->data.write_from_stringlike.start = start;
|
||||
}
|
||||
ret = 1;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JLE_CONNECT: {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Resume a fiber for some events */
|
||||
if (NULL != jlfd->fiber && should_resume) {
|
||||
/* Resume the fiber */
|
||||
Janet out;
|
||||
JanetSignal sig = janet_continue(jlfd->fiber, resumeval, &out);
|
||||
if (sig != JANET_SIGNAL_OK && sig != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(jlfd->fiber, out);
|
||||
}
|
||||
}
|
||||
|
||||
/* Remove this handler from the handler pool. */
|
||||
if (should_resume) janet_loop_rmindex((int) index);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
static void janet_loop1(void) {
|
||||
/* Remove closed file descriptors */
|
||||
for (int i = 0; i < janet_vm_loop_count;) {
|
||||
if (janet_vm_loopfds[i].stream->flags & JANET_STREAM_CLOSED) {
|
||||
janet_loop_rmindex(i);
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
/* Poll */
|
||||
if (janet_vm_loop_count == 0) return;
|
||||
int ready;
|
||||
do {
|
||||
ready = JPOLL(janet_vm_pollfds, janet_vm_loop_count, -1);
|
||||
} while (ready == -1 && JLASTERR == JEINTR);
|
||||
if (ready == -1) return;
|
||||
/* Handle events */
|
||||
for (int i = 0; i < janet_vm_loop_count;) {
|
||||
int revents = janet_vm_pollfds[i].revents;
|
||||
janet_vm_pollfds[i].revents = 0;
|
||||
if ((janet_vm_pollfds[i].events | POLLHUP | POLLERR) & revents) {
|
||||
size_t delta = janet_loop_event(i);
|
||||
i += (int) delta;
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void janet_loop(void) {
|
||||
while (janet_vm_loop_count) {
|
||||
janet_loop1();
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Scheduling Helpers
|
||||
*/
|
||||
|
||||
#define JANET_SCHED_FSOME 1
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags) {
|
||||
JanetLoopFD lfd;
|
||||
lfd.stream = stream;
|
||||
lfd.fiber = janet_root_fiber();
|
||||
lfd.event_type = (flags & JANET_SCHED_FSOME) ? JLE_READ_SOME : JLE_READ_CHUNK;
|
||||
lfd.data.read_chunk.buf = buf;
|
||||
lfd.data.read_chunk.bytes_left = nbytes;
|
||||
janet_loop_schedule(lfd, POLLIN);
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_write_buffer(JanetStream *stream, JanetBuffer *buf) {
|
||||
JanetLoopFD lfd;
|
||||
lfd.stream = stream;
|
||||
lfd.fiber = janet_root_fiber();
|
||||
lfd.event_type = JLE_WRITE_FROM_BUFFER;
|
||||
lfd.data.write_from_buffer.buf = buf;
|
||||
lfd.data.write_from_buffer.start = 0;
|
||||
janet_loop_schedule(lfd, POLLOUT);
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_write_stringlike(JanetStream *stream, const uint8_t *str) {
|
||||
JanetLoopFD lfd;
|
||||
lfd.stream = stream;
|
||||
lfd.fiber = janet_root_fiber();
|
||||
lfd.event_type = JLE_WRITE_FROM_STRINGLIKE;
|
||||
lfd.data.write_from_stringlike.str = str;
|
||||
lfd.data.write_from_stringlike.start = 0;
|
||||
janet_loop_schedule(lfd, POLLOUT);
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Needs argc >= offset + 2 */
|
||||
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset) {
|
||||
/* Get host and port */
|
||||
const char *host = janet_getcstring(argv, offset);
|
||||
const char *port;
|
||||
if (janet_checkint(argv[offset + 1])) {
|
||||
port = (const char *)janet_to_string(argv[offset + 1]);
|
||||
} else {
|
||||
port = janet_getcstring(argv, offset + 1);
|
||||
}
|
||||
/* getaddrinfo */
|
||||
struct addrinfo *ai = NULL;
|
||||
struct addrinfo hints;
|
||||
memset(&hints, 0, sizeof(hints));
|
||||
hints.ai_family = AF_UNSPEC;
|
||||
hints.ai_socktype = SOCK_STREAM;
|
||||
hints.ai_protocol = 0;
|
||||
hints.ai_flags = AI_PASSIVE;
|
||||
int status = getaddrinfo(host, port, &hints, &ai);
|
||||
if (status) {
|
||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||
}
|
||||
return ai;
|
||||
}
|
||||
|
||||
/*
|
||||
* C Funs
|
||||
*/
|
||||
|
||||
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0);
|
||||
|
||||
/* Create socket */
|
||||
JSock sock = socket(ai->ai_family, ai->ai_socktype | JSOCKFLAGS, ai->ai_protocol);
|
||||
if (!JSOCKVALID(sock)) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("could not create socket");
|
||||
}
|
||||
|
||||
/* Connect to socket */
|
||||
int status = connect(sock, ai->ai_addr, (int) ai->ai_addrlen);
|
||||
freeaddrinfo(ai);
|
||||
if (status == -1) {
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panic("could not connect to socket");
|
||||
}
|
||||
|
||||
/* Wrap socket in abstract type JanetStream */
|
||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
}
|
||||
|
||||
static Janet cfun_net_server(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
JanetFunction *fun = janet_getfunction(argv, 2);
|
||||
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0);
|
||||
|
||||
/* Check all addrinfos in a loop for the first that we can bind to. */
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
if (!JSOCKVALID(sfd)) continue;
|
||||
/* Set various socket options */
|
||||
int enable = 1;
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("setsockopt(SO_REUSEADDR) failed");
|
||||
}
|
||||
#ifdef SO_NOSIGPIPE
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("setsockopt(SO_NOSIGPIPE) failed");
|
||||
}
|
||||
#endif
|
||||
#ifdef SO_REUSEPORT
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("setsockopt(SO_REUSEPORT) failed");
|
||||
}
|
||||
#endif
|
||||
/* Bind */
|
||||
if (bind(sfd, rp->ai_addr, (int) rp->ai_addrlen) == 0) break;
|
||||
JSOCKCLOSE(sfd);
|
||||
}
|
||||
if (NULL == rp) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("could not bind to any sockets");
|
||||
}
|
||||
|
||||
/* listen */
|
||||
int status = listen(sfd, 1024);
|
||||
freeaddrinfo(ai);
|
||||
if (status) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("could not listen on file descriptor");
|
||||
}
|
||||
|
||||
/* Put sfd on our loop */
|
||||
JanetLoopFD lfd = {0};
|
||||
lfd.stream = make_stream(sfd, 0);
|
||||
lfd.event_type = JLE_READ_ACCEPT;
|
||||
lfd.data.read_accept.handler = fun;
|
||||
janet_loop_schedule(lfd, POLLIN);
|
||||
|
||||
return janet_wrap_abstract(lfd.stream);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
janet_sched_read(stream, buffer, n, JANET_SCHED_FSOME);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
janet_sched_read(stream, buffer, n, 0);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
janet_stream_close(stream, 0);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
if (janet_checktype(argv[1], JANET_BUFFER)) {
|
||||
janet_sched_write_buffer(stream, janet_getbuffer(argv, 1));
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
janet_sched_write_stringlike(stream, bytes.bytes);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetMethod stream_methods[] = {
|
||||
{"chunk", cfun_stream_chunk},
|
||||
{"close", cfun_stream_close},
|
||||
{"read", cfun_stream_read},
|
||||
{"write", cfun_stream_write},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_stream_getter(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), stream_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg net_cfuns[] = {
|
||||
{
|
||||
"net/server", cfun_net_server,
|
||||
JDOC("(net/server host port handler)\n\n"
|
||||
"Start a TCP server. handler is a function that will be called with a stream "
|
||||
"on each connection to the server. Returns a new stream that is neither readable nor "
|
||||
"writeable.")
|
||||
},
|
||||
{
|
||||
"net/read", cfun_stream_read,
|
||||
JDOC("(net/read stream nbytes &opt buf)\n\n"
|
||||
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
||||
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
||||
"Returns a buffer with up to n more bytes in it.")
|
||||
},
|
||||
{
|
||||
"net/chunk", cfun_stream_chunk,
|
||||
JDOC("(net/chunk stream nbytes &opt buf)\n\n"
|
||||
"Same a net/read, but will wait for all n bytes to arrive rather than return early.")
|
||||
},
|
||||
{
|
||||
"net/write", cfun_stream_write,
|
||||
JDOC("(net/write stream data)\n\n"
|
||||
"Write data to a stream, suspending the current fiber until the write "
|
||||
"completes. Returns stream.")
|
||||
},
|
||||
{
|
||||
"net/close", cfun_stream_close,
|
||||
JDOC("(net/close stream)\n\n"
|
||||
"Close a stream so that no further communication can occur.")
|
||||
},
|
||||
{
|
||||
"net/connect", cfun_net_connect,
|
||||
JDOC("(net/connect host port)\n\n"
|
||||
"Open a connection to communicate with a server. Returns a duplex stream "
|
||||
"that can be used to communicate with the server.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_net(JanetTable *env) {
|
||||
janet_vm_loop_count = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
WSADATA wsaData;
|
||||
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
|
||||
#endif
|
||||
janet_core_cfuns(env, NULL, net_cfuns);
|
||||
}
|
||||
|
||||
void janet_net_deinit(void) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WSACleanup();
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -182,9 +182,18 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
#ifdef JANET_REDUCED_OS
|
||||
/* Provide a dud os/getenv so boot.janet and init.janet work, but nothing else */
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_arity(argc, 1, 2);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#else
|
||||
/* Provide full os functionality */
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
/* Get env for os_execute */
|
||||
static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
char **envp = NULL;
|
||||
@@ -339,7 +348,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
|
||||
JanetBuffer *buf = os_exec_escape(exargs);
|
||||
if (buf->count > 8191) {
|
||||
janet_panic("command line string too long (max 8191 characters)");
|
||||
janet_panic("command line string too long");
|
||||
}
|
||||
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||
char *cargv[2] = {(char *) buf->data, NULL};
|
||||
@@ -380,26 +389,15 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
char *const *cargv = (char *const *)child_argv;
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
int use_environ = !janet_flag_at(flags, 0);
|
||||
|
||||
if (use_environ) {
|
||||
janet_lock_environ();
|
||||
}
|
||||
|
||||
pid_t pid;
|
||||
if (janet_flag_at(flags, 1)) {
|
||||
status = posix_spawnp(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
use_environ ? environ : envp);
|
||||
janet_flag_at(flags, 0) ? envp : environ);
|
||||
} else {
|
||||
status = posix_spawn(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
use_environ ? environ : envp);
|
||||
}
|
||||
|
||||
if (use_environ) {
|
||||
janet_unlock_environ();
|
||||
janet_flag_at(flags, 0) ? envp : environ);
|
||||
}
|
||||
|
||||
/* Wait for child */
|
||||
@@ -435,8 +433,6 @@ static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_boolean(stat);
|
||||
}
|
||||
|
||||
#endif /* JANET_NO_PROCESSES */
|
||||
|
||||
static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
@@ -610,7 +606,7 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
In both cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY));
|
||||
if (randfd < 0)
|
||||
janet_panic(genericerr);
|
||||
while (n > 0) {
|
||||
@@ -757,8 +753,8 @@ static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
t = mktime(&t_info);
|
||||
} else {
|
||||
/* utc time */
|
||||
#ifdef JANET_NO_UTC_MKTIME
|
||||
janet_panic("os/mktime UTC not supported on this platform");
|
||||
#ifdef __sun
|
||||
janet_panic("os/mktime UTC not supported on Solaris");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
t = timegm(&t_info);
|
||||
@@ -772,12 +768,6 @@ static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_number((double)t);
|
||||
}
|
||||
|
||||
#ifdef JANET_NO_SYMLINKS
|
||||
#define j_symlink link
|
||||
#else
|
||||
#define j_symlink symlink
|
||||
#endif
|
||||
|
||||
static Janet os_link(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -788,7 +778,7 @@ static Janet os_link(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
|
||||
int res = ((argc == 3 && janet_truthy(argv[2])) ? symlink : link)(oldpath, newpath);
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
@@ -804,14 +794,12 @@ static Janet os_symlink(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = j_symlink(oldpath, newpath);
|
||||
int res = symlink(oldpath, newpath);
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#undef j_symlink
|
||||
|
||||
static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
@@ -877,7 +865,6 @@ static Janet os_remove(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
static Janet os_readlink(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -894,7 +881,6 @@ static Janet os_readlink(int32_t argc, Janet *argv) {
|
||||
return janet_stringv((const uint8_t *)buffer, len);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
@@ -1163,7 +1149,6 @@ static Janet os_chmod(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifndef JANET_NO_UMASK
|
||||
static Janet os_umask(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int mask = (int) os_getmode(argv, 0);
|
||||
@@ -1174,7 +1159,6 @@ static Janet os_umask(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
return janet_wrap_integer(janet_perm_to_unix(res));
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
@@ -1224,15 +1208,12 @@ static Janet os_rename(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_NO_REALPATH
|
||||
janet_panic("os/realpath not enabled for this platform");
|
||||
#else
|
||||
#ifdef JANET_WINDOWS
|
||||
char *dest = _fullpath(NULL, src, _MAX_PATH);
|
||||
(void) argv;
|
||||
janet_panic("os/realpath not supported on Windows");
|
||||
#else
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
char *dest = realpath(src, NULL);
|
||||
#endif
|
||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
||||
Janet ret = janet_cstringv(dest);
|
||||
free(dest);
|
||||
@@ -1270,8 +1251,12 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:freebsd\n"
|
||||
"\t:openbsd\n"
|
||||
"\t:netbsd\n"
|
||||
"\t:posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.")
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable &opt dflt)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/arch", os_arch,
|
||||
@@ -1291,11 +1276,6 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable &opt dflt)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
@@ -1319,7 +1299,7 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:blocks - number of blocks in file. 0 on windows\n"
|
||||
"\t:blocksize - size of blocks in file. 0 on windows\n"
|
||||
"\t:accessed - timestamp when file last accessed\n"
|
||||
"\t:changed - timestamp when file last changed (permissions changed)\n"
|
||||
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
|
||||
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||
},
|
||||
{
|
||||
@@ -1346,13 +1326,11 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/cd path)\n\n"
|
||||
"Change current directory to path. Returns nil on success, errors on failure.")
|
||||
},
|
||||
#ifndef JANET_NO_UMASK
|
||||
{
|
||||
"os/umask", os_umask,
|
||||
JDOC("(os/umask mask)\n\n"
|
||||
"Set a new umask, returns the old umask.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/mkdir", os_mkdir,
|
||||
JDOC("(os/mkdir path)\n\n"
|
||||
@@ -1378,7 +1356,6 @@ static const JanetReg os_cfuns[] = {
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.")
|
||||
},
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
{
|
||||
"os/symlink", os_symlink,
|
||||
JDOC("(os/symlink oldpath newpath)\n\n"
|
||||
@@ -1389,8 +1366,6 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/readlink path)\n\n"
|
||||
"Read the contents of a symbolic link. Does not work on Windows.\n")
|
||||
},
|
||||
#endif
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute args &opts flags env)\n\n"
|
||||
@@ -1408,7 +1383,6 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
JDOC("(os/setenv variable value)\n\n"
|
||||
|
||||
@@ -167,12 +167,12 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
for (;;) {
|
||||
JanetParseState top = p->states[--p->statecount];
|
||||
JanetParseState *newtop = p->states + p->statecount - 1;
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
/* Source mapping info */
|
||||
if (janet_checktype(val, JANET_TUPLE)) {
|
||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
||||
}
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) p->pending++;
|
||||
@@ -790,7 +790,7 @@ static int parsermark(void *p, size_t size) {
|
||||
janet_mark(parser->args[i]);
|
||||
}
|
||||
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
|
||||
janet_mark(janet_wrap_string((const uint8_t *) parser->error));
|
||||
janet_mark(janet_wrap_string(parser->error));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -928,7 +928,7 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) {
|
||||
return (p->flag & JANET_PARSER_GENERATED_ERROR)
|
||||
? janet_wrap_string((const uint8_t *) err)
|
||||
? janet_wrap_string(err)
|
||||
: janet_cstringv(err);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
@@ -1139,7 +1139,7 @@ static const JanetReg parse_cfuns[] = {
|
||||
"parser/new", cfun_parse_parser,
|
||||
JDOC("(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of values.")
|
||||
"that can receive bytes, and generate a stream of janet values.")
|
||||
},
|
||||
{
|
||||
"parser/clone", cfun_parse_clone,
|
||||
|
||||
@@ -150,7 +150,6 @@ tail:
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
||||
up1(s);
|
||||
text -= ((int32_t *)rule)[1];
|
||||
return result ? text : NULL;
|
||||
}
|
||||
|
||||
@@ -206,29 +205,6 @@ tail:
|
||||
return (result) ? NULL : text;
|
||||
}
|
||||
|
||||
case RULE_THRU:
|
||||
case RULE_TO: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text < s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (next_text) {
|
||||
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
if (text >= s->text_end) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
return rule[0] == RULE_TO ? text : next_text;
|
||||
}
|
||||
|
||||
case RULE_BETWEEN: {
|
||||
uint32_t lo = rule[1];
|
||||
uint32_t hi = rule[2];
|
||||
@@ -437,38 +413,6 @@ tail:
|
||||
return NULL;
|
||||
}
|
||||
|
||||
case RULE_LENPREFIX: {
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (NULL == next_text) return NULL;
|
||||
s->mode = oldmode;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
Janet lencap;
|
||||
if (num_sub_captures <= 0 ||
|
||||
(lencap = s->captures->data[cs.cap], !janet_checkint(lencap))) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
int32_t nrep = janet_unwrap_integer(lencap);
|
||||
/* drop captures from len pattern */
|
||||
cap_load(s, cs);
|
||||
for (int32_t i = 0; i < nrep; i++) {
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[2], next_text);
|
||||
up1(s);
|
||||
if (NULL == next_text) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
return next_text;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -713,9 +657,6 @@ static void spec_if(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_ifnot(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_IFNOT);
|
||||
}
|
||||
static void spec_lenprefix(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_LENPREFIX);
|
||||
}
|
||||
|
||||
static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 3);
|
||||
@@ -788,12 +729,6 @@ static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_DROP);
|
||||
}
|
||||
static void spec_to(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_TO);
|
||||
}
|
||||
static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_THRU);
|
||||
}
|
||||
|
||||
/* Rule of the form [rule, tag] */
|
||||
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||
@@ -912,7 +847,6 @@ static const SpecialPair peg_specials[] = {
|
||||
{"group", spec_group},
|
||||
{"if", spec_if},
|
||||
{"if-not", spec_ifnot},
|
||||
{"lenprefix", spec_lenprefix},
|
||||
{"look", spec_look},
|
||||
{"not", spec_not},
|
||||
{"opt", spec_opt},
|
||||
@@ -924,8 +858,6 @@ static const SpecialPair peg_specials[] = {
|
||||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
{"some", spec_some},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
};
|
||||
|
||||
/* Compile a janet value into a rule and return the rule index. */
|
||||
@@ -1028,14 +960,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
const Janet *tup = janet_unwrap_tuple(peg);
|
||||
int32_t len = janet_tuple_length(tup);
|
||||
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
|
||||
if (janet_checkint(tup[0])) {
|
||||
int32_t n = janet_unwrap_integer(tup[0]);
|
||||
if (n < 0) {
|
||||
peg_panicf(b, "expected non-negative integer, got %d", n);
|
||||
}
|
||||
spec_repeat(b, len, tup);
|
||||
break;
|
||||
}
|
||||
if (!janet_checktype(tup[0], JANET_SYMBOL))
|
||||
peg_panicf(b, "expected grammar command, found %v", tup[0]);
|
||||
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
|
||||
@@ -1176,7 +1100,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
break;
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT:
|
||||
case RULE_LENPREFIX:
|
||||
/* [rule_a, rule_b (b if not a)] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
@@ -1219,8 +1142,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
case RULE_TO:
|
||||
case RULE_THRU:
|
||||
/* [rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
@@ -1362,7 +1283,8 @@ static const JanetReg peg_cfuns[] = {
|
||||
"peg/match", cfun_peg_match,
|
||||
JDOC("(peg/match peg text &opt start & args)\n\n"
|
||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
|
||||
"similar to those defined by LPeg, and have similar capabilities.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -155,9 +155,6 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
case '\\':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||
break;
|
||||
case '\t':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
|
||||
break;
|
||||
default:
|
||||
if (c < 32 || c > 126) {
|
||||
uint8_t buf[4];
|
||||
@@ -530,7 +527,7 @@ 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);
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
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);
|
||||
@@ -594,7 +591,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (counter == JANET_PRETTY_DICT_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
if (counter == JANET_PRETTY_DICT_LIMIT) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
@@ -754,6 +751,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
@@ -804,10 +802,6 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
@@ -815,13 +809,11 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = 4;
|
||||
char d = c[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int has_color = (d == 'P') || (d == 'Q');
|
||||
int has_oneline = (d == 'Q') || (d == 'q');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
@@ -912,6 +904,7 @@ void janet_buffer_format(
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = janet_getinteger(argv, arg);
|
||||
@@ -953,24 +946,19 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = 4;
|
||||
char d = strfrmt[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
char c = strfrmt[-1];
|
||||
int has_color = (c == 'P') || (c == 'Q');
|
||||
int has_oneline = (c == 'Q') || (c == 'q');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -145,7 +145,7 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
|
||||
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
|
||||
int32_t oldmax = ra->max;
|
||||
if (ra->regtemps & (1 << nth)) {
|
||||
JANET_EXIT("regtemp already allocated");
|
||||
janet_exit("regtemp already allocated");
|
||||
}
|
||||
ra->regtemps |= 1 << nth;
|
||||
int32_t reg = janetc_regalloc_1(ra);
|
||||
|
||||
@@ -50,7 +50,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
errflags |= 0x01;
|
||||
done = 1;
|
||||
|
||||
@@ -622,11 +622,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Check if closure created in while scope. If so,
|
||||
* recompile in a function scope. */
|
||||
if (tempscope.flags & JANET_SCOPE_CLOSURE) {
|
||||
subopts = janetc_fopts_default(c);
|
||||
tempscope.flags |= JANET_SCOPE_UNUSED;
|
||||
janetc_popscope(c);
|
||||
if (c->buffer) janet_v__cnt(c->buffer) = labelwt;
|
||||
if (c->mapbuffer) janet_v__cnt(c->mapbuffer) = labelwt;
|
||||
janet_v__cnt(c->buffer) = labelwt;
|
||||
janet_v__cnt(c->mapbuffer) = labelwt;
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
|
||||
|
||||
|
||||
@@ -43,7 +43,6 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber;
|
||||
|
||||
/* The current pointer to the inner most jmp_buf. The current
|
||||
* return point for panics. */
|
||||
|
||||
@@ -542,7 +542,7 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/from-bytes", cfun_string_frombytes,
|
||||
JDOC("(string/from-bytes & byte-vals)\n\n"
|
||||
"Creates a string from integer parameters with byte values. All integers "
|
||||
"Creates a string from integer params with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
@@ -573,7 +573,7 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/find-all", cfun_string_findall,
|
||||
JDOC("(string/find-all patt str)\n\n"
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
"Searches for all instances of pattern patt in string "
|
||||
"str. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are not counted, meaning a byte in string "
|
||||
@@ -627,7 +627,7 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/format", cfun_string_format,
|
||||
JDOC("(string/format format & values)\n\n"
|
||||
"Similar to snprintf, but specialized for operating with Janet values. Returns "
|
||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -66,15 +66,9 @@ struct JanetMailbox {
|
||||
JanetBuffer messages[];
|
||||
};
|
||||
|
||||
#define JANET_THREAD_HEAVYWEIGHT 0x1
|
||||
#define JANET_THREAD_ABSTRACTS 0x2
|
||||
#define JANET_THREAD_CFUNCTIONS 0x4
|
||||
static const char janet_thread_flags[] = "hac";
|
||||
|
||||
typedef struct {
|
||||
JanetMailbox *original;
|
||||
JanetMailbox *newbox;
|
||||
uint64_t flags;
|
||||
} JanetMailboxPair;
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
@@ -181,7 +175,7 @@ static int thread_mark(void *p, size_t size) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -189,7 +183,6 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flag
|
||||
pair->original = original;
|
||||
janet_mailbox_ref(original, 1);
|
||||
pair->newbox = janet_mailbox_create(1, 16);
|
||||
pair->flags = flags;
|
||||
return pair;
|
||||
}
|
||||
|
||||
@@ -449,44 +442,16 @@ static int thread_worker(JanetMailboxPair *pair) {
|
||||
janet_init();
|
||||
|
||||
/* Get dictionaries for default encode/decode */
|
||||
JanetTable *encode;
|
||||
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
encode = janet_get_core_table("make-image-dict");
|
||||
} else {
|
||||
encode = NULL;
|
||||
janet_vm_thread_decode = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(pair->original, encode);
|
||||
Janet parentv = janet_wrap_abstract(parent);
|
||||
|
||||
/* Unmarshal the abstract registry */
|
||||
if (pair->flags & JANET_THREAD_ABSTRACTS) {
|
||||
Janet reg;
|
||||
int status = janet_thread_receive(®, INFINITY);
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(reg, JANET_TABLE)) goto error;
|
||||
janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
janet_vm_abstract_registry = janet_unwrap_table(reg);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
}
|
||||
|
||||
/* Unmarshal the normal registry */
|
||||
if (pair->flags & JANET_THREAD_CFUNCTIONS) {
|
||||
Janet reg;
|
||||
int status = janet_thread_receive(®, INFINITY);
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(reg, JANET_TABLE)) goto error;
|
||||
janet_gcunroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_vm_registry = janet_unwrap_table(reg);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
}
|
||||
|
||||
/* Unmarshal the function */
|
||||
Janet funcv;
|
||||
int status = janet_thread_receive(&funcv, INFINITY);
|
||||
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
|
||||
JanetFunction *func = janet_unwrap_function(funcv);
|
||||
@@ -500,15 +465,11 @@ static int thread_worker(JanetMailboxPair *pair) {
|
||||
Janet argv[1] = { parentv };
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Normal exit */
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_deinit();
|
||||
@@ -593,40 +554,22 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
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);
|
||||
}
|
||||
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
|
||||
JanetTable *encode;
|
||||
if (flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
encode = janet_get_core_table("make-image-dict");
|
||||
} else {
|
||||
encode = NULL;
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
|
||||
JanetThread *thread = janet_make_thread(pair->newbox, encode);
|
||||
if (janet_thread_start_child(pair)) {
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
if (flags & JANET_THREAD_ABSTRACTS) {
|
||||
if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
|
||||
janet_panic("could not send abstract registry to thread");
|
||||
}
|
||||
}
|
||||
|
||||
if (flags & JANET_THREAD_CFUNCTIONS) {
|
||||
if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
|
||||
janet_panic("could not send registry to 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]);
|
||||
@@ -691,14 +634,10 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new func &opt capacity flags)\n\n"
|
||||
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. "
|
||||
"Can optionally provide flags to the new thread - supported flags are:\n"
|
||||
"\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
|
||||
"\t:a - Allow sending over registered abstract types to the new thread\n"
|
||||
"\t:c - Send over cfunction information to the new thread.\n"
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -275,24 +275,6 @@ static void ta_setter(void *p, Janet key, Janet value) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet ta_view_next(void *p, Janet key) {
|
||||
JanetTArrayView *view = p;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
if (view->size > 0) {
|
||||
return janet_wrap_number(0);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
size_t index = (size_t) janet_unwrap_number(key);
|
||||
index++;
|
||||
if (index < view->size) {
|
||||
return janet_wrap_number((double) index);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
@@ -301,11 +283,7 @@ const JanetAbstractType janet_ta_view_type = {
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
ta_view_next,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
@@ -386,11 +364,8 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
|
||||
buffer = p;
|
||||
} else {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
buffer = p;
|
||||
}
|
||||
}
|
||||
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||
|
||||
@@ -32,10 +32,10 @@
|
||||
#include <errno.h>
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef JANET_EXIT
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
@@ -44,13 +44,13 @@
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) JANET_EXIT((m)); \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
@@ -126,10 +126,5 @@ void janet_lib_inttypes(JanetTable *env);
|
||||
#ifdef JANET_THREADS
|
||||
void janet_lib_thread(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
void janet_lib_net(JanetTable *env);
|
||||
void janet_net_deinit(void);
|
||||
void janet_net_markloop(void);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -38,7 +38,6 @@ JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
|
||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber = NULL;
|
||||
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
|
||||
JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
|
||||
@@ -929,7 +928,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
@@ -968,7 +967,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
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;
|
||||
@@ -1245,9 +1244,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
janet_vm_stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
janet_panicv(*janet_vm_return_reg);
|
||||
}
|
||||
if (signal != JANET_SIGNAL_OK) janet_panicv(*janet_vm_return_reg);
|
||||
|
||||
return *janet_vm_return_reg;
|
||||
}
|
||||
@@ -1279,12 +1276,10 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
JanetFiber *child = fiber->child;
|
||||
janet_vm_stackn++;
|
||||
JanetSignal sig = janet_continue(child, in, &in);
|
||||
janet_vm_stackn--;
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
*out = in;
|
||||
return sig;
|
||||
@@ -1313,7 +1308,6 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
Janet *old_vm_return_reg = janet_vm_return_reg;
|
||||
|
||||
/* Setup fiber */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
@@ -1339,7 +1333,6 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
|
||||
/* Restore global state */
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
janet_vm_gc_suspend = handle;
|
||||
janet_vm_fiber = old_vm_fiber;
|
||||
janet_vm_stackn = oldn;
|
||||
@@ -1421,10 +1414,6 @@ int janet_init(void) {
|
||||
janet_vm_core_env = NULL;
|
||||
/* Seed RNG */
|
||||
janet_rng_seed(janet_default_rng(), 0);
|
||||
/* Fibers */
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
janet_vm_stackn = 0;
|
||||
/* Threads */
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
@@ -1444,12 +1433,7 @@ void janet_deinit(void) {
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_net_deinit();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -27,12 +27,6 @@
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/* Variable length arrays are ok */
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning( push )
|
||||
#pragma warning( disable : 4200 )
|
||||
#endif
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#include "janetconf.h"
|
||||
@@ -130,12 +124,6 @@ extern "C" {
|
||||
/* Check emscripten */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define JANET_NO_DYNAMIC_MODULES
|
||||
#define JANET_NO_PROCESSES
|
||||
#endif
|
||||
|
||||
/* Check sun */
|
||||
#ifdef __sun
|
||||
#define JANET_NO_UTC_MKTIME
|
||||
#endif
|
||||
|
||||
/* Define how global janet state is declared */
|
||||
@@ -171,11 +159,6 @@ extern "C" {
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable networking */
|
||||
#if !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_NET
|
||||
#endif
|
||||
|
||||
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
|
||||
#ifndef JANET_NO_INT_TYPES
|
||||
#define JANET_INT_TYPES
|
||||
@@ -306,8 +289,6 @@ typedef enum {
|
||||
JANET_SIGNAL_USER9
|
||||
} JanetSignal;
|
||||
|
||||
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
|
||||
|
||||
/* Fiber statuses - mostly corresponds to signals. */
|
||||
typedef enum {
|
||||
JANET_STATUS_DEAD,
|
||||
@@ -328,6 +309,14 @@ typedef enum {
|
||||
JANET_STATUS_ALIVE
|
||||
} JanetFiberStatus;
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
typedef union Janet Janet;
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
typedef union Janet Janet;
|
||||
#else
|
||||
typedef struct Janet Janet;
|
||||
#endif
|
||||
|
||||
/* Use type punning for GC objects */
|
||||
typedef struct JanetGCObject JanetGCObject;
|
||||
|
||||
@@ -358,6 +347,15 @@ typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
typedef struct JanetRange JanetRange;
|
||||
typedef struct JanetRNG JanetRNG;
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* String and other aliased pointer types */
|
||||
typedef const uint8_t *JanetString;
|
||||
typedef const uint8_t *JanetSymbol;
|
||||
typedef const uint8_t *JanetKeyword;
|
||||
typedef const Janet *JanetTuple;
|
||||
typedef const JanetKV *JanetStruct;
|
||||
typedef void *JanetAbstract;
|
||||
|
||||
/* Basic types for all Janet Values */
|
||||
typedef enum JanetType {
|
||||
@@ -379,61 +377,6 @@ typedef enum JanetType {
|
||||
JANET_POINTER
|
||||
} JanetType;
|
||||
|
||||
/* Recursive type (Janet) */
|
||||
#ifdef JANET_NANBOX_64
|
||||
typedef union Janet Janet;
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
typedef union Janet Janet;
|
||||
union Janet {
|
||||
struct {
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
uint32_t type;
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
#else
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
#else
|
||||
typedef struct Janet Janet;
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
} as;
|
||||
JanetType type;
|
||||
};
|
||||
#endif
|
||||
|
||||
/* C functions */
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* String and other aliased pointer types */
|
||||
typedef const uint8_t *JanetString;
|
||||
typedef const uint8_t *JanetSymbol;
|
||||
typedef const uint8_t *JanetKeyword;
|
||||
typedef const Janet *JanetTuple;
|
||||
typedef const JanetKV *JanetStruct;
|
||||
typedef void *JanetAbstract;
|
||||
|
||||
#define JANET_COUNT_TYPES (JANET_POINTER + 1)
|
||||
|
||||
/* Type flags */
|
||||
@@ -542,6 +485,13 @@ JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
|
||||
#include <math.h>
|
||||
|
||||
/* 64 Nanboxed Janet value */
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#define janet_u64(x) ((x).u64)
|
||||
|
||||
#define JANET_NANBOX_TAGBITS 0xFFFF800000000000llu
|
||||
@@ -626,6 +576,27 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
|
||||
/* 32 bit nanboxed janet */
|
||||
union Janet {
|
||||
struct {
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
uint32_t type;
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
#else
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
|
||||
#define JANET_DOUBLE_OFFSET 0xFFFF
|
||||
|
||||
#define janet_u64(x) ((x).u64)
|
||||
@@ -676,6 +647,18 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
#else
|
||||
|
||||
/* A general janet value type for more standard C */
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
} as;
|
||||
JanetType type;
|
||||
};
|
||||
|
||||
#define janet_u64(x) ((x).as.u64)
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
@@ -1128,11 +1111,6 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
|
||||
/***** START SECTION MAIN *****/
|
||||
|
||||
/* Event Loop */
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_loop(void);
|
||||
#endif
|
||||
|
||||
/* Parsing */
|
||||
extern JANET_API const JanetAbstractType janet_parser_type;
|
||||
JANET_API void janet_parser_init(JanetParser *parser);
|
||||
@@ -1302,14 +1280,12 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
||||
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
|
||||
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||
JANET_API JanetTable *janet_table_clone(JanetTable *table);
|
||||
JANET_API void janet_table_clear(JanetTable *table);
|
||||
|
||||
/* Fiber */
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
|
||||
JANET_API JanetFiber *janet_current_fiber(void);
|
||||
JANET_API JanetFiber *janet_root_fiber(void);
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||
@@ -1369,7 +1345,6 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
||||
/* Pretty printing */
|
||||
#define JANET_PRETTY_COLOR 1
|
||||
#define JANET_PRETTY_ONELINE 2
|
||||
#define JANET_PRETTY_NOTRUNC 4
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
@@ -1583,9 +1558,6 @@ typedef enum {
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
RULE_TO, /* [rule] */
|
||||
RULE_THRU, /* [rule] */
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
typedef struct {
|
||||
@@ -1682,11 +1654,6 @@ JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/* Re-enable popped variable length array warnings */
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning( pop )
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -40,8 +40,6 @@ void janet_line_deinit();
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
static JANET_THREAD_LOCAL int gbl_cancel_current_repl_form = 0;
|
||||
|
||||
/*
|
||||
* Line Editing
|
||||
*/
|
||||
@@ -56,17 +54,7 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
gbl_complete_env = (argc >= 3) ? janet_gettable(argv, 2) : NULL;
|
||||
janet_line_get(str, buf);
|
||||
gbl_complete_env = NULL;
|
||||
|
||||
Janet result;
|
||||
if (gbl_cancel_current_repl_form) {
|
||||
gbl_cancel_current_repl_form = 0;
|
||||
|
||||
/* Signal that the user bailed out of the current form */
|
||||
result = janet_ckeywordv("cancel");
|
||||
} else {
|
||||
result = janet_wrap_buffer(buf);
|
||||
}
|
||||
return result;
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
@@ -758,7 +746,8 @@ static int line() {
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
gbl_cancel_current_repl_form = 1;
|
||||
errno = EAGAIN;
|
||||
gbl_sigint_flag = 1;
|
||||
clearlines();
|
||||
return -1;
|
||||
case 4: /* ctrl-d, eof */
|
||||
@@ -1022,15 +1011,10 @@ int main(int argc, char **argv) {
|
||||
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 && status != JANET_SIGNAL_EVENT) {
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
status = JANET_SIGNAL_OK;
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
1
test/install/.gitignore
vendored
1
test/install/.gitignore
vendored
@@ -1,5 +1,4 @@
|
||||
/build
|
||||
/modpath
|
||||
.cache
|
||||
.manifests
|
||||
json.*
|
||||
|
||||
@@ -334,86 +334,5 @@
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
|
||||
|
||||
## Polymorphic comparison -- Issue #272
|
||||
|
||||
# confirm polymorphic comparison delegation to primitive comparators:
|
||||
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||
|
||||
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
|
||||
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
|
||||
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
|
||||
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
|
||||
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
|
||||
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
|
||||
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
|
||||
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
|
||||
(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
|
||||
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
|
||||
(assert (compare< 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) "compare type ordering")
|
||||
|
||||
# test polymorphic compare with 'objects' (table/setproto)
|
||||
(def mynum
|
||||
@{:type :mynum :v 0 :compare
|
||||
(fn [self other]
|
||||
(case (type other)
|
||||
:number (compare-primitive (self :v) other)
|
||||
:table (when (= (get other :type) :mynum)
|
||||
(compare-primitive (self :v) (other :v)))))})
|
||||
|
||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||
(assert (= -1 (compare n3 4)) "compare object to num (2)")
|
||||
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
|
||||
(assert (compare< 2 n3 4) "compare< poly")
|
||||
(assert (compare> 4 n3 2) "compare> poly")
|
||||
(assert (compare<= 2 3 n3 4) "compare<= poly")
|
||||
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
|
||||
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
|
||||
|
||||
(let [
|
||||
MAX_INT_64_STRING "9223372036854775807"
|
||||
MAX_UINT_64_STRING "18446744073709551615"
|
||||
MAX_INT_IN_DBL_STRING "9007199254740991"
|
||||
NAN (math/log -1)
|
||||
INF (/ 1 0)
|
||||
MINUS_INF (/ -1 0)
|
||||
|
||||
compare-poly-tests
|
||||
[
|
||||
[(int/s64 3) (int/u64 3) 0]
|
||||
[(int/s64 -3) (int/u64 3) -1]
|
||||
[(int/s64 3) (int/u64 2) 1]
|
||||
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
|
||||
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
|
||||
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
|
||||
[3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
|
||||
[(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
|
||||
[(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
|
||||
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
|
||||
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]
|
||||
]]
|
||||
(each [x y c] compare-poly-tests
|
||||
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c)))
|
||||
)
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -91,8 +91,8 @@
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm (asm '{
|
||||
:arity 1
|
||||
:bytecode [
|
||||
arity 1
|
||||
bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
|
||||
@@ -58,17 +58,6 @@
|
||||
|
||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||
|
||||
# Issue 408
|
||||
(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument")
|
||||
(def ta (tarray/new :int32 10))
|
||||
(assert (= (next a nil) 0) "tarray next 1")
|
||||
(assert (= (next a 0) 1) "tarray next 2")
|
||||
(assert (= (next a 8) 9) "tarray next 3")
|
||||
(assert (nil? (next a 9)) "tarray next 4")
|
||||
(put ta 3 7)
|
||||
(put ta 9 7)
|
||||
(assert (= 2 (count |(= $ 7) ta)) "tarray count")
|
||||
|
||||
# Array remove
|
||||
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
|
||||
# Using a large test grammar
|
||||
|
||||
(def- core-env (table/getproto (fiber/getenv (fiber/current))))
|
||||
(def- specials {'fn true
|
||||
'var true
|
||||
'do true
|
||||
@@ -40,7 +41,7 @@
|
||||
(defn capture-sym
|
||||
[text]
|
||||
(def sym (symbol text))
|
||||
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
|
||||
[(if (or (core-env sym) (specials sym)) :coresym :symbol) text])
|
||||
|
||||
(def grammar
|
||||
~{:ws (set " \v\t\r\f\n\0")
|
||||
|
||||
@@ -252,59 +252,4 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
|
||||
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
|
||||
|
||||
# Lenprefix rule
|
||||
|
||||
(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":") ,scan-number) 1) -1)))
|
||||
|
||||
(assert (peg/match peg "5:abcde") "lenprefix 1")
|
||||
(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
|
||||
(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
|
||||
|
||||
# Packet capture
|
||||
|
||||
(def peg2
|
||||
(peg/compile
|
||||
~{# capture packet length in tag :header-len
|
||||
:packet-header (* (/ ':d+ ,scan-number :header-len) ":")
|
||||
|
||||
# capture n bytes from a backref :header-len
|
||||
:packet-body '(lenprefix (-> :header-len) 1)
|
||||
|
||||
# header, followed by body, and drop the :header-len capture
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
|
||||
# any exact seqence of packets (no extra characters)
|
||||
:main (* (any :packet) -1)}))
|
||||
|
||||
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc")) "lenprefix 4")
|
||||
(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc")) "lenprefix 5")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
|
||||
|
||||
# Regression #400
|
||||
(assert (= nil (while (and false false) (fn []) (error "should not happen"))) "strangeloop 1")
|
||||
(assert (= nil (while (not= nil nil) (fn []) (error "should not happen"))) "strangeloop 2")
|
||||
|
||||
# Issue #412
|
||||
(assert (peg/match '(* "a" (> -1 "a") "b") "abc") "lookhead does not move cursor")
|
||||
|
||||
(def peg3
|
||||
~{:main (* "(" (thru ")"))})
|
||||
|
||||
(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
|
||||
|
||||
(assert (peg/match peg3 "(12345)") "peg thru 1")
|
||||
(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
|
||||
(assert (not (peg/match peg3 "(12345")) "peg thru 3")
|
||||
|
||||
(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
|
||||
(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
|
||||
(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
|
||||
|
||||
(def peg5 (peg/compile [3 "abc"]))
|
||||
|
||||
(assert (:match peg5 "abcabcabc") "repeat alias 1")
|
||||
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
|
||||
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,51 +0,0 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 9)
|
||||
|
||||
# Net testing
|
||||
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(:read stream 1024 b)
|
||||
(:write stream b)
|
||||
(buffer/clear b)))
|
||||
|
||||
(def s (net/server "127.0.0.1" "8000" handler))
|
||||
(assert s "made server 1")
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(:write conn msg)
|
||||
(def res (:read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
|
||||
(test-echo "hello")
|
||||
(test-echo "world")
|
||||
(test-echo (string/repeat "abcd" 200))
|
||||
|
||||
(:close s)
|
||||
|
||||
(end-suite)
|
||||
BIN
tools/EnVar.dll
Normal file
BIN
tools/EnVar.dll
Normal file
Binary file not shown.
Binary file not shown.
|
Before Width: | Height: | Size: 24 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 2.0 KiB |
Binary file not shown.
@@ -1,200 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
|
||||
<?define Name = "Janet" ?>
|
||||
<?define Description = "The Janet Programming Language" ?>
|
||||
<?define Manufacturer = "Janet-Lang.org" ?>
|
||||
<?define WebPage = "https://janet-lang.org" ?>
|
||||
<?ifdef env.JANET_VERSION ?>
|
||||
<?define Version = "$(env.JANET_VERSION)" ?>
|
||||
<?else?>
|
||||
<?define Version = "0.0.0" ?>
|
||||
<?endif?>
|
||||
<?if $(sys.BUILDARCH)="x64" ?>
|
||||
<?define UpgradeCode="712CACD6-09AA-430A-831C-80FDFFE3F9ED" ?>
|
||||
<?define ProgramFilesFolder="ProgramFiles64Folder" ?>
|
||||
<?define Win64="yes" ?>
|
||||
<?define Arch="(x64)" ?>
|
||||
<?elseif $(sys.BUILDARCH)="x86" ?>
|
||||
<?define UpgradeCode="0411837a-82c4-4dc7-872b-134d0c1b0228" ?>
|
||||
<?define ProgramFilesFolder="ProgramFilesFolder" ?>
|
||||
<?define Win64="no" ?>
|
||||
<?define Arch="(x86)" ?>
|
||||
<?else ?>
|
||||
<?error Unsupported value of sys.BUILDARCH=$(sys.BUILDARCH)?>
|
||||
<?endif?>
|
||||
<?define BaseRegKey="Software\Microsoft\$(var.Manufacturer)\$(var.Name)" ?>
|
||||
|
||||
|
||||
<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
|
||||
<Product Id="*"
|
||||
Name="$(var.Name)"
|
||||
Language="1033"
|
||||
Version="$(var.Version)"
|
||||
Manufacturer="$(var.Manufacturer)"
|
||||
UpgradeCode="$(var.UpgradeCode)">
|
||||
<Package Compressed="yes"
|
||||
InstallScope="perUser"
|
||||
Manufacturer="$(var.Manufacturer)"
|
||||
Description="$(var.Description)" />
|
||||
<MajorUpgrade DowngradeErrorMessage="A later version of [ProductName] is already installed. Setup will now exit."/>
|
||||
<MediaTemplate EmbedCab="yes" />
|
||||
<Property Id="DISABLEADVTSHORTCUTS" Value="1" />
|
||||
|
||||
<!-- Set UI images (use the -b option to light.exe to set where these files are) -->
|
||||
<WixVariable Id="WixUIBannerBmp" Value="JanetTopBanner.png" />
|
||||
<WixVariable Id="WixUIDialogBmp" Value="JanetDialog.png" />
|
||||
<WixVariable Id="WixUILicenseRtf" Value="LICENSE.rtf" />
|
||||
|
||||
<Icon Id="Janet.ico" SourceFile="assets\icon.ico" />
|
||||
|
||||
<!-- Add some details to Add/Remove Programs entry -->
|
||||
<Property Id="ARPPRODUCTICON" Value="Janet.ico" />
|
||||
<Property Id='ARPCOMMENTS'>$(var.Description)</Property>
|
||||
<Property Id='ARPURLINFOABOUT'>$(var.WebPage)</Property>
|
||||
<Property Id='COMPANY'>$(var.Manufacturer)</Property>
|
||||
|
||||
<!-- Default to per-user installs -->
|
||||
<Property Id="WixAppFolder" Value="WixPerUserFolder" />
|
||||
|
||||
<Property Id="ApplicationFolderName" Value="$(var.Name)" />
|
||||
|
||||
<!-- Fix WixUI_Advanced to work with x64 -->
|
||||
<CustomAction Id="WixSetDefaultPerMachineFolderPerArch"
|
||||
Property="WixPerMachineFolder"
|
||||
Value="[$(var.ProgramFilesFolder)][ApplicationFolderName]"
|
||||
Execute="immediate"/>
|
||||
<InstallExecuteSequence>
|
||||
<Custom Action="WixSetDefaultPerMachineFolderPerArch" Before="WixSetPerMachineFolder" />
|
||||
</InstallExecuteSequence>
|
||||
<InstallUISequence>
|
||||
<Custom Action="WixSetDefaultPerMachineFolderPerArch" Before="WixSetPerMachineFolder" />
|
||||
</InstallUISequence>
|
||||
|
||||
<Directory Id="TARGETDIR" Name="SourceDir">
|
||||
<Directory Id="$(var.ProgramFilesFolder)">
|
||||
<Directory Id="APPLICATIONFOLDER" Name="$(var.Name)">
|
||||
<Directory Id="BinDir" Name="bin"/>
|
||||
<Directory Id="CDir" Name="C"/>
|
||||
<Directory Id="DocsDir" Name="docs"/>
|
||||
<Directory Id="LibraryDir" Name="Library"/>
|
||||
</Directory>
|
||||
</Directory>
|
||||
<Directory Id="ProgramMenuFolder">
|
||||
<Directory Id="ApplicationProgramsFolder" Name="$(var.Name)" />
|
||||
</Directory>
|
||||
</Directory>
|
||||
|
||||
<!--
|
||||
Define the files to be installed.
|
||||
File/@Source is relative to where this file is compiled, the root of the repository in this case.
|
||||
File/@Name is the destination file name, if not set it defaults to the file name part of Source.
|
||||
Component/@Directory is the Id of the destination directory - where the directory name and
|
||||
hierarchy is set in the section above
|
||||
-->
|
||||
<ComponentGroup Id="Files">
|
||||
<Component Directory="APPLICATIONFOLDER">
|
||||
<File Source="README.md"/>
|
||||
<RemoveFolder Id="RemoveRootDir" On="uninstall" />
|
||||
</Component>
|
||||
<Component Directory="APPLICATIONFOLDER">
|
||||
<File Source="LICENSE"/>
|
||||
</Component>
|
||||
<Component Directory="APPLICATIONFOLDER">
|
||||
<File Source="assets\icon.ico"/>
|
||||
</Component>
|
||||
|
||||
<Component Directory="BinDir">
|
||||
<File Source="dist\janet.exe" KeyPath="yes">
|
||||
<Shortcut Id="JanetExeShortcut"
|
||||
Directory="ApplicationProgramsFolder"
|
||||
Name="$(var.Name)"
|
||||
Description="$(var.Description)"
|
||||
Icon="Janet.ico"
|
||||
Advertise="yes"
|
||||
WorkingDirectory="INSTALLFOLDER" />
|
||||
</File>
|
||||
<RemoveFolder Id="RemoveBinDir" On="uninstall" />
|
||||
</Component>
|
||||
<Component Directory="BinDir">
|
||||
<File Source="jpm" Name="jpm.janet"/>
|
||||
</Component>
|
||||
<Component Directory="BinDir">
|
||||
<File Source="tools\jpm.bat"/>
|
||||
</Component>
|
||||
|
||||
<Component Directory="CDir">
|
||||
<File Source="dist\janet.h"/>
|
||||
<RemoveFolder Id="RemoveCDir" On="uninstall" />
|
||||
</Component>
|
||||
<Component Directory="CDir">
|
||||
<File Source="dist\janetconf.h"/>
|
||||
</Component>
|
||||
<Component Directory="CDir">
|
||||
<File Source="dist\janet.lib"/>
|
||||
</Component>
|
||||
<Component Directory="CDir">
|
||||
<File Source="dist\janet.exp"/>
|
||||
</Component>
|
||||
<Component Directory="CDir">
|
||||
<File Source="dist\janet.c"/>
|
||||
</Component>
|
||||
<Component Directory="CDir">
|
||||
<File Source="dist\libjanet.lib"/>
|
||||
</Component>
|
||||
|
||||
<Component Id="LibraryComponent" Directory="LibraryDir" Guid="3860e981-5f94-4002-b5d5-2d9ec0d2792d" KeyPath="yes">
|
||||
<RemoveFolder Id="RemoveLibraryDir" On="uninstall" />
|
||||
</Component>
|
||||
|
||||
<Component Id="DocsComponent" Directory="DocsDir">
|
||||
<File Source="dist\doc.html" Name="docs.html" KeyPath="yes">
|
||||
<Shortcut Id="JanetDocsShortcut"
|
||||
Directory="ApplicationProgramsFolder"
|
||||
Name="$(var.Name) Documentation"
|
||||
Description="$(var.Description)"
|
||||
Advertise="yes"/>
|
||||
</File>
|
||||
<RemoveFolder Id="RemoveDocsDir" On="uninstall" />
|
||||
</Component>
|
||||
</ComponentGroup>
|
||||
|
||||
<Component Id="StartMenu" Directory="ApplicationProgramsFolder">
|
||||
<RegistryValue Root="HKMU" Key="$(var.BaseRegKey)" Name="installed" Type="integer" Value="1" KeyPath="yes" />
|
||||
<RemoveFolder Id="RemoveApplicationProgramsFolder" On="uninstall" />
|
||||
</Component>
|
||||
|
||||
<!-- This component is duplicated with different conditions so that we can set system or user environment variables -->
|
||||
<Component Id="SetEnvVarsPerMachine" Directory="ApplicationProgramsFolder" Guid="57b1e1ef-89c8-4ce4-9f0f-37618677c5a4" KeyPath="yes">
|
||||
<Condition>ALLUSERS=1</Condition>
|
||||
<Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
|
||||
<Environment Id="JANET_BINPATH_PERMACHINE" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="yes"/>
|
||||
<Environment Id="JANET_PATH_PERMACHINE" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="yes" />
|
||||
<Environment Id="JANET_HEADERPATH_PERMACHINE" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
|
||||
<Environment Id="JANET_LIBPATH_PERMACHINE" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
|
||||
</Component>
|
||||
<Component Id="SetEnvVarsPerUser" Directory="ApplicationProgramsFolder" Guid="128be307-488b-49aa-971a-d2ae00a1a584" KeyPath="yes">
|
||||
<Condition>NOT ALLUSERS=1</Condition>
|
||||
<Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="no" Part="last"/>
|
||||
<Environment Id="JANET_BINPATH_PERUSER" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="no"/>
|
||||
<Environment Id="JANET_PATH_PERUSER" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="no" />
|
||||
<Environment Id="JANET_HEADERPATH_PERUSER" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
|
||||
<Environment Id="JANET_LIBPATH_PERUSER" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
|
||||
</Component>
|
||||
|
||||
<Feature Id="MainFeature" Title="$(var.Name) $(var.Version)"
|
||||
Level="1" Absent="disallow" AllowAdvertise="no" InstallDefault="local"
|
||||
Description="$(var.Description)">
|
||||
<ComponentGroupRef Id="Files" />
|
||||
<ComponentRef Id="StartMenu" />
|
||||
<ComponentRef Id="SetEnvVarsPerMachine" />
|
||||
<ComponentRef Id="SetEnvVarsPerUser" />
|
||||
</Feature>
|
||||
|
||||
<UI>
|
||||
<UIRef Id="WixUI_Advanced"/>
|
||||
<!-- FindRelatedProducts runs before the user select the install scope, so we ask it to run again if the have changed the scope
|
||||
-->
|
||||
<Publish Dialog="InstallScopeDlg" Control="Next" Order="8" Event="DoAction" Value="FindRelatedProducts">WixAppFolder = "WixPerMachineFolder"</Publish>
|
||||
</UI>
|
||||
</Product>
|
||||
</Wix>
|
||||
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,33 +0,0 @@
|
||||
# Patch jpm to have the correct paths for the current install.
|
||||
# usage: janet patch-jpm.janet output --libdir=/usr/local/lib/x64-linux/ --binpath
|
||||
|
||||
(def- argpeg
|
||||
(peg/compile
|
||||
'(* "--" '(to "=") "=" '(any 1))))
|
||||
|
||||
(def- args (tuple/slice (dyn :args) 3))
|
||||
(def- len (length args))
|
||||
(var i :private 0)
|
||||
|
||||
(def install-paths @{})
|
||||
|
||||
# Get flags
|
||||
(each a args
|
||||
(if-let [m (peg/match argpeg a)]
|
||||
(let [[key value] m]
|
||||
(put install-paths (keyword key) value))))
|
||||
|
||||
(def- replace-peg
|
||||
(peg/compile
|
||||
~(% (* '(to "###START###")
|
||||
(constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths))
|
||||
(thru "###END###")
|
||||
'(any 1)))))
|
||||
|
||||
(def source (slurp ((dyn :args) 1)))
|
||||
(def newsource (0 (peg/match replace-peg source)))
|
||||
|
||||
(spit ((dyn :args) 2) newsource)
|
||||
|
||||
(unless (= :windows (os/which))
|
||||
(os/shell (string `chmod +x "` ((dyn :args) 2) `"`)))
|
||||
@@ -230,53 +230,53 @@
|
||||
<key>name</key>
|
||||
<string>punctuation.other.janet</string>
|
||||
</dict>
|
||||
<!-- string>(?<![\.:\w_\-=!@\$%^&?/<>*]) token match here (?![\.:\w_\-=!@\$%^&?/<>*])</string -->
|
||||
<!-- string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*]) token match here (?![\.:\w_\-=!@\$%^&?|\\/<>*])</string -->
|
||||
<key>literal</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*])(true|false|nil)(?![\.:\w_\-=!@\$%^&?/<>*])</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])(true|false|nil)(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<key>name</key>
|
||||
<string>constant.language.janet</string>
|
||||
</dict>
|
||||
<key>corelib</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*])(%ALLSYMBOLS%)(?![\.:\w_\-=!@\$%^&?/<>*])</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])(%ALLSYMBOLS%)(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<key>name</key>
|
||||
<string>keyword.control.janet</string>
|
||||
</dict>
|
||||
<key>keysym</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*]):[\.:\w_\-=!@\$%^&?/<>*]*</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*]):[\.:\w_\-=!@\$%^&?|\\/<>*]*</string>
|
||||
<key>name</key>
|
||||
<string>constant.keyword.janet</string>
|
||||
</dict>
|
||||
<key>symbol</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*])[\.a-zA-Z_\-=!@\$%^&?/<>*][\.:\w_\-=!@\$%^&?/<>*]*</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[\.a-zA-Z_\-=!@\$%^&?|\\/<>*][\.:\w_\-=!@\$%^&?|\\/<>*]*</string>
|
||||
<key>name</key>
|
||||
<string>variable.other.janet</string>
|
||||
</dict>
|
||||
<key>hex-number</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*])[-+]?0x([_\da-fA-F]+|[_\da-fA-F]+\.[_\da-fA-F]*|\.[_\da-fA-F]+)(&[+-]?[\da-fA-F]+)?(?![\.:\w_\-=!@\$%^&?/<>*])</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[-+]?0x([_\da-fA-F]+|[_\da-fA-F]+\.[_\da-fA-F]*|\.[_\da-fA-F]+)(&[+-]?[\da-fA-F]+)?(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<key>name</key>
|
||||
<string>constant.numeric.hex.janet</string>
|
||||
</dict>
|
||||
<key>dec-number</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*])[-+]?([_\d]+|[_\d]+\.[_\d]*|\.[_\d]+)([eE&][+-]?[\d]+)?(?![\.:\w_\-=!@\$%^&?/<>*])</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[-+]?([_\d]+|[_\d]+\.[_\d]*|\.[_\d]+)([eE&][+-]?[\d]+)?(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<key>name</key>
|
||||
<string>constant.numeric.decimal.janet</string>
|
||||
</dict>
|
||||
<key>r-number</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?/<>*])[-+]?\d\d?r([_\w]+|[_\w]+\.[_\w]*|\.[_\w]+)(&[+-]?[\w]+)?(?![\.:\w_\-=!@\$%^&?/<>*])</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[-+]?\d\d?r([_\w]+|[_\w]+\.[_\w]*|\.[_\w]+)(&[+-]?[\w]+)?(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<key>name</key>
|
||||
<string>constant.numeric.decimal.janet</string>
|
||||
</dict>
|
||||
|
||||
Reference in New Issue
Block a user