mirror of
https://github.com/janet-lang/janet
synced 2025-11-07 19:13:02 +00:00
Compare commits
194 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
01aab66667 | ||
|
|
aa5c987a94 | ||
|
|
75229332c8 | ||
|
|
9d5b1ba838 | ||
|
|
f27b225b34 | ||
|
|
3c523d66e9 | ||
|
|
1144c27c54 | ||
|
|
b442b21d3f | ||
|
|
746ff5307d | ||
|
|
ef85b24d8f | ||
|
|
c55d93512b | ||
|
|
2e38f9ba61 | ||
|
|
1cadff8e58 | ||
|
|
d1eba60ba8 | ||
|
|
057dccad8f | ||
|
|
4285200b4b | ||
|
|
73c2fbbc2a | ||
|
|
37b7e170fa | ||
|
|
b032d94877 | ||
|
|
9476016741 | ||
|
|
7a1c9c7798 | ||
|
|
c7fb7b4451 | ||
|
|
67c474fc7a | ||
|
|
4e8154cf8a | ||
|
|
9582d3c623 | ||
|
|
0079500713 | ||
|
|
55af6ce834 | ||
|
|
3e82fdc125 | ||
|
|
7344a6cfc0 | ||
|
|
0aded71343 | ||
|
|
7663b1e703 | ||
|
|
282546c03f | ||
|
|
f4bc89d1c0 | ||
|
|
fa277c3797 | ||
|
|
c0c8ab25e6 | ||
|
|
b685bf3026 | ||
|
|
ce31db09e4 | ||
|
|
624a6cf619 | ||
|
|
587aa87d28 | ||
|
|
88813c4f87 | ||
|
|
dacbe29771 | ||
|
|
244833cfa1 | ||
|
|
05e7f974e3 | ||
|
|
0dbef65a73 | ||
|
|
9106228787 | ||
|
|
6ae3bdb25c | ||
|
|
310bcec260 | ||
|
|
8c4cc4e671 | ||
|
|
c6eaaa83ed | ||
|
|
8f598d6f96 | ||
|
|
20bc323d17 | ||
|
|
8b0bcf4db9 | ||
|
|
8955e6f536 | ||
|
|
f8ddea6452 | ||
|
|
987e04086d | ||
|
|
85f2acbf52 | ||
|
|
1acf4c3ab7 | ||
|
|
07a3158fba | ||
|
|
2f8bed9d82 | ||
|
|
a490937cd9 | ||
|
|
8ee5942481 | ||
|
|
93b469885a | ||
|
|
d8d1de2dcb | ||
|
|
ab224514f0 | ||
|
|
75179de8da | ||
|
|
c28df14e6b | ||
|
|
b73855b193 | ||
|
|
2093ab2baa | ||
|
|
a0f40042cb | ||
|
|
3254c2c477 | ||
|
|
0a8eb9e3ba | ||
|
|
70e0c6f9ef | ||
|
|
a8a78d4525 | ||
|
|
57e6ee963d | ||
|
|
ce6bfb8420 | ||
|
|
f0672bdc59 | ||
|
|
23de953fbd | ||
|
|
03c496bdd8 | ||
|
|
d5ee6cf521 | ||
|
|
fb7981e053 | ||
|
|
846123ecab | ||
|
|
373cb444fe | ||
|
|
90f212df92 | ||
|
|
12286e4246 | ||
|
|
aa60c1f36a | ||
|
|
c731f01067 | ||
|
|
6c9c1cdb30 | ||
|
|
9ba2b40e87 | ||
|
|
7a3d055012 | ||
|
|
0824f45e29 | ||
|
|
4debe3446c | ||
|
|
07fe9bcdf6 | ||
|
|
6a557a73f5 | ||
|
|
8d1cfe0c56 | ||
|
|
a3a42eebea | ||
|
|
76be8006a4 | ||
|
|
bfcfd58259 | ||
|
|
914a4360e7 | ||
|
|
8c31874eeb | ||
|
|
ef7afeb2ea | ||
|
|
4067f883a2 | ||
|
|
c8974fffbe | ||
|
|
b75fb8dc9e | ||
|
|
57356781a9 | ||
|
|
e43eab5fd6 | ||
|
|
894cd0e022 | ||
|
|
db2c63fffc | ||
|
|
60e0f32f1a | ||
|
|
e731996a68 | ||
|
|
2f69cd4209 | ||
|
|
fd59de25c5 | ||
|
|
af12c3d41a | ||
|
|
54b52bbeb5 | ||
|
|
1174c68d9a | ||
|
|
448ea7167f | ||
|
|
6b27008c99 | ||
|
|
725c785882 | ||
|
|
ab068cff67 | ||
|
|
9dc03adfda | ||
|
|
49f9e4eddf | ||
|
|
43c47ac44c | ||
|
|
1cebe64664 | ||
|
|
f33c381043 | ||
|
|
3479841c77 | ||
|
|
6a899968a9 | ||
|
|
bb8405a36e | ||
|
|
c7bc711f63 | ||
|
|
e326071c35 | ||
|
|
ad6a669381 | ||
|
|
e4c9dafc9a | ||
|
|
dfc0aefd87 | ||
|
|
356b39c6f5 | ||
|
|
8da7bb6b68 | ||
|
|
9341081a4d | ||
|
|
324a086eb4 | ||
|
|
ed595f52c2 | ||
|
|
64ad0023bb | ||
|
|
fe5f661d15 | ||
|
|
ff26e3a8ba | ||
|
|
14657a762c | ||
|
|
4754fa3902 | ||
|
|
f302f87337 | ||
|
|
94dbcde292 | ||
|
|
4336a174b1 | ||
|
|
0adb13ed71 | ||
|
|
03ba1f7021 | ||
|
|
1f7f20788c | ||
|
|
c59dd29190 | ||
|
|
99f63a41a3 | ||
|
|
a575f5df36 | ||
|
|
0817e627ee | ||
|
|
14d90239a7 | ||
|
|
f5d11dc656 | ||
|
|
6dcf5bf077 | ||
|
|
ac2082e9b3 | ||
|
|
dbac495bee | ||
|
|
fe5ccb163e | ||
|
|
1aea5ee007 | ||
|
|
13cd9f8067 | ||
|
|
34496ecaf0 | ||
|
|
c043b1d949 | ||
|
|
9a6d2a7b32 | ||
|
|
f8a9efa8e4 | ||
|
|
5b2169e0d1 | ||
|
|
2c927ea768 | ||
|
|
f4bbcdcbc8 | ||
|
|
79c375b1af | ||
|
|
f443a3b3a1 | ||
|
|
684d2d63f4 | ||
|
|
1900d8f843 | ||
|
|
3c2af95d21 | ||
|
|
b35414ea0f | ||
|
|
fb5b056f7b | ||
|
|
7248c1dfdb | ||
|
|
4c7ea9e893 | ||
|
|
c7801ce277 | ||
|
|
f741a8e3ff | ||
|
|
6a92e8b609 | ||
|
|
9da91a8217 | ||
|
|
69853c8e5c | ||
|
|
1f41b6c138 | ||
|
|
e001efa9fd | ||
|
|
435e64d4cf | ||
|
|
f296c8f5fb | ||
|
|
8d0e6ed32f | ||
|
|
b6a36afffe | ||
|
|
e422abc269 | ||
|
|
221d71d07b | ||
|
|
9f35f0837e | ||
|
|
515891b035 | ||
|
|
94a506876f | ||
|
|
9bde57854a | ||
|
|
f456369941 | ||
|
|
e0b7533c39 |
@@ -13,7 +13,7 @@ tasks:
|
||||
gmake test-install
|
||||
- meson_min: |
|
||||
cd janet
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true -Dffi=false
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
|
||||
cd build_meson_min
|
||||
ninja
|
||||
- meson_prf: |
|
||||
|
||||
41
.github/workflows/codeql.yml
vendored
Normal file
41
.github/workflows/codeql.yml
vendored
Normal file
@@ -0,0 +1,41 @@
|
||||
name: "CodeQL"
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [ "master" ]
|
||||
pull_request:
|
||||
branches: [ "master" ]
|
||||
schedule:
|
||||
- cron: "2 7 * * 4"
|
||||
|
||||
jobs:
|
||||
analyze:
|
||||
name: Analyze
|
||||
runs-on: ubuntu-latest
|
||||
permissions:
|
||||
actions: read
|
||||
contents: read
|
||||
security-events: write
|
||||
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
language: [ cpp ]
|
||||
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v3
|
||||
|
||||
- name: Initialize CodeQL
|
||||
uses: github/codeql-action/init@v2
|
||||
with:
|
||||
languages: ${{ matrix.language }}
|
||||
queries: +security-and-quality
|
||||
|
||||
- name: Autobuild
|
||||
uses: github/codeql-action/autobuild@v2
|
||||
|
||||
- name: Perform CodeQL Analysis
|
||||
uses: github/codeql-action/analyze@v2
|
||||
with:
|
||||
category: "/language:${{ matrix.language }}"
|
||||
22
.github/workflows/test.yml
vendored
22
.github/workflows/test.yml
vendored
@@ -35,3 +35,25 @@ jobs:
|
||||
- name: Test the project
|
||||
shell: cmd
|
||||
run: build_win test
|
||||
|
||||
test-mingw:
|
||||
name: Build on Windows with Mingw (no test yet)
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: msys2 {0}
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Setup Mingw
|
||||
uses: msys2/setup-msys2@v2
|
||||
with:
|
||||
msystem: UCRT64
|
||||
update: true
|
||||
install: >-
|
||||
base-devel
|
||||
git
|
||||
gcc
|
||||
- name: Build the project
|
||||
shell: cmd
|
||||
run: make -j CC=gcc
|
||||
|
||||
5
.gitignore
vendored
5
.gitignore
vendored
@@ -68,10 +68,13 @@ tags
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Wix artifacts
|
||||
# WiX artifacts
|
||||
*.msi
|
||||
*.wixpdb
|
||||
|
||||
# Makefile config
|
||||
/config.mk
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
|
||||
60
CHANGELOG.md
60
CHANGELOG.md
@@ -1,6 +1,66 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.27.0 - 2023-03-05
|
||||
- Change semantics around bracket tuples to no longer be equal to regular tuples.
|
||||
- Add `index` argument to `ffi/write` for symmetry with `ffi/read`.
|
||||
- Add `buffer/push-at`
|
||||
- Add `ffi/pointer-buffer` to convert pointers to buffers the cannot be reallocated. This
|
||||
allows easier manipulation of FFI memory, memory mapped files, and buffer memory shared between threads.
|
||||
- Calling `ev/cancel` on a fiber waiting on `ev/gather` will correctly
|
||||
cancel the child fibers.
|
||||
- Add `(sandbox ...)` function to core for permission based security. Also add `janet_sandbox` to C API.
|
||||
The sandbox allows limiting access to the file system, network, ffi, and OS resources at runtime.
|
||||
- Add `(.locals)` function to debugger to see currently bound local symbols.
|
||||
- Track symbol -> slot mapping so debugger can get symbolic information. This exposes local bindings
|
||||
in `debug/stack` and `disasm`.
|
||||
- Add `os/compiler` to detect what host compiler was used to compile the interpreter
|
||||
- Add support for mingw and cygwin builds (mingw support also added in jpm).
|
||||
|
||||
## 1.26.0 - 2023-01-07
|
||||
- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
|
||||
- Add `ffi/jitfn` to allow calling function pointers generated at runtime from machine code.
|
||||
Bring your own assembler, though.
|
||||
- Channels can now be marshalled. Pending state is not saved, only items in the channel.
|
||||
- Use the new `.length` function pointer on abstract types for lengths. Adding
|
||||
a `length` method will still work as well.
|
||||
- Support byte views on abstract types with the `.bytes` function pointer.
|
||||
- Add the `u` format specifier to printf family functions.
|
||||
- Allow printing 64 integer types in `printf` and `string/format` family functions.
|
||||
- Allow importing modules from custom directories more easily with the `@` prefix
|
||||
to module paths. For example, if there is a dynamic binding :custom-modules that
|
||||
is a file system path to a directory of modules, import from that directory with
|
||||
`(import @custom-modules/mymod)`.
|
||||
- Fix error message bug in FFI library.
|
||||
|
||||
## 1.25.1 - 2022-10-29
|
||||
- Add `memcmp` function to core library.
|
||||
- Fix bug in `os/open` with `:rw` permissions not correct on Linux.
|
||||
- Support config.mk for more easily configuring the Makefile.
|
||||
|
||||
## 1.25.0 - 2022-10-10
|
||||
- Windows FFI fixes.
|
||||
- Fix PEG `if-not` combinator with captures in the condition
|
||||
- Fix bug with `os/date` with nil first argument
|
||||
- Fix bug with `net/accept` on Linux that could leak file descriptors to subprocesses
|
||||
- Reduce number of hash collisions from pointer hashing
|
||||
- Add optional parameter to `marshal` to skip cycle checking code
|
||||
|
||||
## 1.24.1 - 2022-08-24
|
||||
- Fix FFI bug on Linux/Posix
|
||||
- Improve parse error messages for bad delimiters.
|
||||
- Add optional `name` parameter to the `short-fn` macro.
|
||||
|
||||
## 1.24.0 - 2022-08-14
|
||||
- Add FFI support to 64-bit windows compiled with MSVC
|
||||
- Don't process shared object names passed to dlopen.
|
||||
- Add better support for windows console in the default shell.c for auto-completion and
|
||||
other shell-like input features.
|
||||
- Improve default error message from `assert`.
|
||||
- Add the `tabseq` macro for simpler table comprehensions.
|
||||
- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
|
||||
this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
|
||||
|
||||
## 1.23.0 - 2022-06-20
|
||||
- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
|
||||
on 64 bit linux, mac, and bsd systems.
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2021 Calvin Rose and contributors
|
||||
Copyright (c) 2023 Calvin Rose and contributors
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
|
||||
33
Makefile
33
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,15 +21,17 @@
|
||||
################################
|
||||
##### Set global variables #####
|
||||
################################
|
||||
|
||||
sinclude config.mk
|
||||
PREFIX?=/usr/local
|
||||
|
||||
JANETCONF_HEADER?=src/conf/janetconf.h
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_IMPORT_LIB=build/janet.lib
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
@@ -76,6 +78,12 @@ ifeq ($(shell uname -o), Android)
|
||||
endif
|
||||
endif
|
||||
|
||||
# Mingw
|
||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
|
||||
@@ -83,7 +91,7 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
##### Name Files #####
|
||||
######################
|
||||
|
||||
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
||||
JANET_HEADERS=src/include/janet.h $(JANETCONF_HEADER)
|
||||
|
||||
JANET_LOCAL_HEADERS=src/core/features.h \
|
||||
src/core/util.h \
|
||||
@@ -168,24 +176,24 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.23.dylib
|
||||
SONAME=libjanet.1.27.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.23
|
||||
SONAME=libjanet.so.1.27
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
|
||||
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
|
||||
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
build/janetconf.h: $(JANETCONF_HEADER)
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
|
||||
build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
|
||||
build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
@@ -283,7 +291,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf '$(DESTDIR)$(INCLUDEDIR)/janet/janet.h' '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
if test $(UNAME) = Darwin ; then \
|
||||
@@ -300,7 +308,8 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
||||
|
||||
install-jpm-git: $(JANET_TARGET)
|
||||
mkdir -p build
|
||||
|
||||
@@ -2,22 +2,68 @@
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
|
||||
#ifdef _WIN32
|
||||
#define EXPORTER __declspec(dllexport)
|
||||
#else
|
||||
#define EXPORTER
|
||||
#endif
|
||||
|
||||
/* Structs */
|
||||
|
||||
typedef struct {
|
||||
int a, b;
|
||||
float c, d;
|
||||
} Split;
|
||||
|
||||
typedef struct {
|
||||
float c, d;
|
||||
int a, b;
|
||||
} SplitFlip;
|
||||
|
||||
typedef struct {
|
||||
int u, v, w, x, y, z;
|
||||
} SixInts;
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
} intint;
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
int c;
|
||||
} intintint;
|
||||
|
||||
typedef struct {
|
||||
int64_t a;
|
||||
int64_t b;
|
||||
int64_t c;
|
||||
} big;
|
||||
|
||||
/* Functions */
|
||||
|
||||
EXPORTER
|
||||
int int_fn(int a, int b) {
|
||||
return (a << 2) + b;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double my_fn(int64_t a, int64_t b, const char *x) {
|
||||
return (double)(a + b) + 0.5 + strlen(x);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double double_fn(double x, double y, double z) {
|
||||
return (x + y) * z * 3;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double double_many(double x, double y, double z, double w, double a, double b) {
|
||||
return x + y + z + w + a + b;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double double_lots(
|
||||
double a,
|
||||
double b,
|
||||
@@ -32,31 +78,49 @@ double double_lots(
|
||||
return i + j;
|
||||
}
|
||||
|
||||
|
||||
EXPORTER
|
||||
double double_lots_2(
|
||||
double a,
|
||||
double b,
|
||||
double c,
|
||||
double d,
|
||||
double e,
|
||||
double f,
|
||||
double g,
|
||||
double h,
|
||||
double i,
|
||||
double j) {
|
||||
return a +
|
||||
10.0 * b +
|
||||
100.0 * c +
|
||||
1000.0 * d +
|
||||
10000.0 * e +
|
||||
100000.0 * f +
|
||||
1000000.0 * g +
|
||||
10000000.0 * h +
|
||||
100000000.0 * i +
|
||||
1000000000.0 * j;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
double float_fn(float x, float y, float z) {
|
||||
return (x + y) * z;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
} intint;
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
int c;
|
||||
} intintint;
|
||||
|
||||
EXPORTER
|
||||
int intint_fn(double x, intint ii) {
|
||||
printf("double: %g\n", x);
|
||||
return ii.a + ii.b;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int intintint_fn(double x, intintint iii) {
|
||||
printf("double: %g\n", x);
|
||||
return iii.a + iii.b + iii.c;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
intint return_struct(int i) {
|
||||
intint ret;
|
||||
ret.a = i;
|
||||
@@ -64,12 +128,7 @@ intint return_struct(int i) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
int64_t a;
|
||||
int64_t b;
|
||||
int64_t c;
|
||||
} big;
|
||||
|
||||
EXPORTER
|
||||
big struct_big(int i, double d) {
|
||||
big ret;
|
||||
ret.a = i;
|
||||
@@ -78,10 +137,72 @@ big struct_big(int i, double d) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
void void_fn(void) {
|
||||
printf("void fn ran\n");
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
void void_fn_2(double y) {
|
||||
printf("y = %f\n", y);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
void void_ret_fn(int x) {
|
||||
printf("void fn ran: %d\n", x);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int intintint_fn_2(intintint iii, int i) {
|
||||
fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
|
||||
return i * (iii.a + iii.b + iii.c);
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
float split_fn(Split s) {
|
||||
return s.a * s.c + s.b * s.d;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
float split_flip_fn(SplitFlip s) {
|
||||
return s.a * s.c + s.b * s.d;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
Split split_ret_fn(int x, float y) {
|
||||
Split ret;
|
||||
ret.a = x;
|
||||
ret.b = x;
|
||||
ret.c = y;
|
||||
ret.d = y;
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
SplitFlip split_flip_ret_fn(int x, float y) {
|
||||
SplitFlip ret;
|
||||
ret.a = x;
|
||||
ret.b = x;
|
||||
ret.c = y;
|
||||
ret.d = y;
|
||||
return ret;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
SixInts sixints_fn(void) {
|
||||
return (SixInts) {
|
||||
6666, 1111, 2222, 3333, 4444, 5555
|
||||
};
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int sixints_fn_2(int x, SixInts s) {
|
||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||
}
|
||||
|
||||
EXPORTER
|
||||
int sixints_fn_3(SixInts s, int x) {
|
||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -2,96 +2,59 @@
|
||||
# Simple FFI test script that tests against a simple shared object
|
||||
#
|
||||
|
||||
(def ffi/loc "examples/ffi/so.so")
|
||||
(def is-windows (= :windows (os/which)))
|
||||
(def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
|
||||
(def ffi/source-loc "examples/ffi/so.c")
|
||||
|
||||
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px)
|
||||
(def module (ffi/native ffi/loc))
|
||||
(if is-windows
|
||||
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
|
||||
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
|
||||
|
||||
(def int-fn-sig (ffi/signature :default :int :int :int))
|
||||
(def int-fn-pointer (ffi/lookup module "int_fn"))
|
||||
(defn int-fn
|
||||
[x y]
|
||||
(ffi/call int-fn-pointer int-fn-sig x y))
|
||||
|
||||
(def double-fn-sig (ffi/signature :default :double :double :double :double))
|
||||
(def double-fn-pointer (ffi/lookup module "double_fn"))
|
||||
(defn double-fn
|
||||
[x y z]
|
||||
(ffi/call double-fn-pointer double-fn-sig x y z))
|
||||
|
||||
(def double-many-sig (ffi/signature :default :double :double :double :double :double :double :double))
|
||||
(def double-many-pointer (ffi/lookup module "double_many"))
|
||||
(defn double-many
|
||||
[x y z w a b]
|
||||
(ffi/call double-many-pointer double-many-sig x y z w a b))
|
||||
|
||||
(def double-lots-sig (ffi/signature :default :double
|
||||
:double :double :double :double :double
|
||||
:double :double :double :double :double))
|
||||
(def double-lots-pointer (ffi/lookup module "double_lots"))
|
||||
(defn double-lots
|
||||
[a b c d e f g h i j]
|
||||
(ffi/call double-lots-pointer double-lots-sig a b c d e f g h i j))
|
||||
|
||||
(def float-fn-sig (ffi/signature :default :double :float :float :float))
|
||||
(def float-fn-pointer (ffi/lookup module "float_fn"))
|
||||
(defn float-fn
|
||||
[x y z]
|
||||
(ffi/call float-fn-pointer float-fn-sig x y z))
|
||||
|
||||
(def intint-fn-sig (ffi/signature :default :int :double [:int :int]))
|
||||
(def intint-fn-pointer (ffi/lookup module "intint_fn"))
|
||||
(defn intint-fn
|
||||
[x ii]
|
||||
(ffi/call intint-fn-pointer intint-fn-sig x ii))
|
||||
|
||||
(def return-struct-sig (ffi/signature :default [:int :int] :int))
|
||||
(def return-struct-pointer (ffi/lookup module "return_struct"))
|
||||
(defn return-struct-fn
|
||||
[i]
|
||||
(ffi/call return-struct-pointer return-struct-sig i))
|
||||
(ffi/context ffi/loc)
|
||||
|
||||
(def intintint (ffi/struct :int :int :int))
|
||||
(def intintint-fn-sig (ffi/signature :default :int :double intintint))
|
||||
(def intintint-fn-pointer (ffi/lookup module "intintint_fn"))
|
||||
(defn intintint-fn
|
||||
[x iii]
|
||||
(ffi/call intintint-fn-pointer intintint-fn-sig x iii))
|
||||
|
||||
(def big (ffi/struct :s64 :s64 :s64))
|
||||
(def struct-big-fn-sig (ffi/signature :default big :int :double))
|
||||
(def struct-big-fn-pointer (ffi/lookup module "struct_big"))
|
||||
(defn struct-big-fn
|
||||
[i d]
|
||||
(ffi/call struct-big-fn-pointer struct-big-fn-sig i d))
|
||||
(def split (ffi/struct :int :int :float :float))
|
||||
(def split-flip (ffi/struct :float :float :int :int))
|
||||
(def six-ints (ffi/struct :int :int :int :int :int :int))
|
||||
|
||||
(def void-fn-pointer (ffi/lookup module "void_fn"))
|
||||
(def void-fn-sig (ffi/signature :default :void))
|
||||
(defn void-fn
|
||||
[]
|
||||
(ffi/call void-fn-pointer void-fn-sig))
|
||||
|
||||
#
|
||||
# Call functions
|
||||
#
|
||||
|
||||
(pp (void-fn))
|
||||
(pp (int-fn 10 20))
|
||||
(pp (double-fn 1.5 2.5 3.5))
|
||||
(pp (double-many 1 2 3 4 5 6))
|
||||
(pp (double-lots 1 2 3 4 5 6 7 8 9 10))
|
||||
(pp (float-fn 8 4 17))
|
||||
(pp (intint-fn 123.456 [10 20]))
|
||||
(pp (intintint-fn 123.456 [10 20 30]))
|
||||
(pp (return-struct-fn 42))
|
||||
(pp (struct-big-fn 11 99.5))
|
||||
|
||||
(assert (= 60 (int-fn 10 20)))
|
||||
(assert (= 42 (double-fn 1.5 2.5 3.5)))
|
||||
(assert (= 21 (double-many 1 2 3 4 5 6)))
|
||||
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
|
||||
(assert (= 204 (float-fn 8 4 17)))
|
||||
(ffi/defbind int-fn :int [a :int b :int])
|
||||
(ffi/defbind double-fn :double [a :double b :double c :double])
|
||||
(ffi/defbind double-many :double
|
||||
[x :double y :double z :double w :double a :double b :double])
|
||||
(ffi/defbind double-lots :double
|
||||
[a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
|
||||
(ffi/defbind float-fn :double
|
||||
[x :float y :float z :float])
|
||||
(ffi/defbind intint-fn :int
|
||||
[x :double ii [:int :int]])
|
||||
(ffi/defbind return-struct [:int :int]
|
||||
[i :int])
|
||||
(ffi/defbind intintint-fn :int
|
||||
[x :double iii intintint])
|
||||
(ffi/defbind struct-big big
|
||||
[i :int d :double])
|
||||
(ffi/defbind void-fn :void [])
|
||||
(ffi/defbind double-lots-2 :double
|
||||
[a :double
|
||||
b :double
|
||||
c :double
|
||||
d :double
|
||||
e :double
|
||||
f :double
|
||||
g :double
|
||||
h :double
|
||||
i :double
|
||||
j :double])
|
||||
(ffi/defbind void-fn-2 :void [y :double])
|
||||
(ffi/defbind intintint-fn-2 :int [iii intintint i :int])
|
||||
(ffi/defbind split-fn :float [s split])
|
||||
(ffi/defbind split-flip-fn :float [s split-flip])
|
||||
(ffi/defbind split-ret-fn split [x :int y :float])
|
||||
(ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
|
||||
(ffi/defbind sixints-fn six-ints [])
|
||||
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
|
||||
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
|
||||
|
||||
#
|
||||
# Struct reading and writing
|
||||
@@ -129,4 +92,43 @@
|
||||
(check-round-trip s [1 3 5 123.5])
|
||||
(check-round-trip s [-1 -3 -5 -123.5])
|
||||
|
||||
#
|
||||
# Call functions
|
||||
#
|
||||
|
||||
(tracev (sixints-fn))
|
||||
(tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
|
||||
(tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
|
||||
(tracev (split-ret-fn 10 12))
|
||||
(tracev (split-flip-ret-fn 10 12))
|
||||
(tracev (split-flip-ret-fn 12 10))
|
||||
(tracev (intintint-fn-2 [10 20 30] 3))
|
||||
(tracev (split-fn [5 6 1.2 3.4]))
|
||||
(tracev (void-fn-2 10.3))
|
||||
(tracev (double-many 1 2 3 4 5 6))
|
||||
(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
|
||||
(tracev (type (double-many 1 2 3 4 5 6)))
|
||||
(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
|
||||
(tracev (void-fn))
|
||||
(tracev (int-fn 10 20))
|
||||
(tracev (double-fn 1.5 2.5 3.5))
|
||||
(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
|
||||
(tracev (float-fn 8 4 17))
|
||||
(tracev (intint-fn 123.456 [10 20]))
|
||||
(tracev (intintint-fn 123.456 [10 20 30]))
|
||||
(tracev (return-struct 42))
|
||||
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
||||
(tracev (struct-big 11 99.5))
|
||||
|
||||
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
||||
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
||||
(assert (= 183 (intintint-fn-2 [10 20 31] 3)))
|
||||
(assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
|
||||
(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
|
||||
(assert (= 60 (int-fn 10 20)))
|
||||
(assert (= 42 (double-fn 1.5 2.5 3.5)))
|
||||
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
|
||||
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
|
||||
(assert (= 204 (float-fn 8 4 17)))
|
||||
|
||||
(print "Done.")
|
||||
|
||||
7
examples/ffi/win32.janet
Normal file
7
examples/ffi/win32.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
(ffi/context "user32.dll")
|
||||
|
||||
(ffi/defbind MessageBoxA :int
|
||||
[w :ptr text :string cap :string typ :int])
|
||||
|
||||
(MessageBoxA nil "Hello, World!" "Test" 0)
|
||||
|
||||
BIN
examples/jitfn/hello.bin
Normal file
BIN
examples/jitfn/hello.bin
Normal file
Binary file not shown.
17
examples/jitfn/hello.nasm
Normal file
17
examples/jitfn/hello.nasm
Normal file
@@ -0,0 +1,17 @@
|
||||
BITS 64
|
||||
|
||||
;;;
|
||||
;;; Code
|
||||
;;;
|
||||
mov rax, 1 ; write(
|
||||
mov rdi, 1 ; STDOUT_FILENO,
|
||||
lea rsi, [rel msg] ; msg,
|
||||
mov rdx, msglen ; sizeof(msg)
|
||||
syscall ; );
|
||||
ret ; return;
|
||||
|
||||
;;;
|
||||
;;; Constants
|
||||
;;;
|
||||
msg: db "Hello, world!", 10
|
||||
msglen: equ $ - msg
|
||||
13
examples/jitfn/jitfn.janet
Normal file
13
examples/jitfn/jitfn.janet
Normal file
@@ -0,0 +1,13 @@
|
||||
###
|
||||
### Relies on NASM being installed to assemble code.
|
||||
### Only works on x86-64 Linux.
|
||||
###
|
||||
### Before running, compile hello.nasm to hello.bin with
|
||||
### $ nasm hello.nasm -o hello.bin
|
||||
|
||||
(def bin (slurp "hello.bin"))
|
||||
(def f (ffi/jitfn bin))
|
||||
(def signature (ffi/signature :default :void))
|
||||
(ffi/call f signature)
|
||||
(print "called a jitted function with FFI!")
|
||||
(print "machine code: " (describe (string/slice f)))
|
||||
2
examples/lineloop.janet
Normal file
2
examples/lineloop.janet
Normal file
@@ -0,0 +1,2 @@
|
||||
(while (not (empty? (def line (getline))))
|
||||
(prin "line: " line))
|
||||
30
examples/marshal-stress.janet
Normal file
30
examples/marshal-stress.janet
Normal file
@@ -0,0 +1,30 @@
|
||||
(defn init-db [c]
|
||||
(def res @{:clients @{}})
|
||||
(var i 0)
|
||||
(repeat c
|
||||
(def n (string "client" i))
|
||||
(put-in res [:clients n] @{:name n :projects @{}})
|
||||
(++ i)
|
||||
(repeat c
|
||||
(def pn (string "project" i))
|
||||
(put-in res [:clients n :projects pn] @{:name pn})
|
||||
(++ i)
|
||||
(repeat c
|
||||
(def tn (string "task" i))
|
||||
(put-in res [:clients n :projects pn :tasks tn] @{:name pn})
|
||||
(++ i))))
|
||||
res)
|
||||
|
||||
(loop [c :range [30 80 1]]
|
||||
(var s (os/clock))
|
||||
(print "Marshal DB with " c " clients, "
|
||||
(* c c) " projects and "
|
||||
(* c c c) " tasks. "
|
||||
"Total " (+ (* c c c) (* c c) c) " tables")
|
||||
(def buf (marshal (init-db c) @{} @""))
|
||||
(print "Buffer is " (length buf) " bytes")
|
||||
(print "Duration " (- (os/clock) s))
|
||||
(set s (os/clock))
|
||||
(gccollect)
|
||||
(print "Collected garbage in " (- (os/clock) s)))
|
||||
|
||||
7
janet.1
7
janet.1
@@ -164,10 +164,15 @@ Execute a string of Janet source. Source code is executed in the order it is enc
|
||||
arguments are executed before later ones.
|
||||
|
||||
.TP
|
||||
.BR \-E\ code arguments
|
||||
.BR \-E\ code\ arguments...
|
||||
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
|
||||
more concise one-liners with command line arguments.
|
||||
|
||||
Example: janet -E '(print $0)' 12 is equivalent to '((short-fn (print $0)) 12)', which is in turn equivalent to
|
||||
`((fn [k] (print k)) 12)`
|
||||
|
||||
See docs for the `short-fn` function for more details.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
|
||||
11
meson.build
11
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose and contributors
|
||||
# Copyright (c) 2023 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.23.0')
|
||||
version : '1.27.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -77,6 +77,7 @@ conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
|
||||
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
|
||||
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
||||
conf.set('JANET_NO_FFI', not get_option('ffi'))
|
||||
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -236,7 +237,11 @@ test_files = [
|
||||
'test/suite0007.janet',
|
||||
'test/suite0008.janet',
|
||||
'test/suite0009.janet',
|
||||
'test/suite0010.janet'
|
||||
'test/suite0010.janet',
|
||||
'test/suite0011.janet',
|
||||
'test/suite0012.janet',
|
||||
'test/suite0013.janet',
|
||||
'test/suite0014.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
|
||||
@@ -20,6 +20,7 @@ option('epoll', type : 'boolean', value : false)
|
||||
option('kqueue', type : 'boolean', value : false)
|
||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||
option('ffi', type : 'boolean', value : true)
|
||||
option('ffi_jit', type : 'boolean', value : true)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2022 © Calvin Rose
|
||||
# Copyright 2023 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -76,6 +76,11 @@
|
||||
[name & more]
|
||||
~(var ,name :private ,;more))
|
||||
|
||||
(defmacro toggle
|
||||
"Set a value to its boolean inverse. Same as `(set value (not value))`."
|
||||
[value]
|
||||
~(set ,value (,not ,value)))
|
||||
|
||||
(defn defglobal
|
||||
"Dynamically create a global def."
|
||||
[name value]
|
||||
@@ -124,20 +129,18 @@
|
||||
# For macros, we define an imcomplete odd? function that will be overriden.
|
||||
(defn odd? [x] (= 1 (mod x 2)))
|
||||
|
||||
(def idempotent?
|
||||
```
|
||||
(idempotent? x)
|
||||
(def- non-atomic-types
|
||||
{:array true
|
||||
:tuple true
|
||||
:table true
|
||||
:buffer true
|
||||
:symbol true
|
||||
:struct true})
|
||||
|
||||
Check if x is a value that evaluates to itself when compiled.
|
||||
```
|
||||
(do
|
||||
(def non-atomic-types
|
||||
{:array true
|
||||
:tuple true
|
||||
:table true
|
||||
:buffer true
|
||||
:struct true})
|
||||
(fn idempotent? [x] (not (in non-atomic-types (type x))))))
|
||||
(defn idempotent?
|
||||
"Check if x is a value that evaluates to itself when compiled."
|
||||
[x]
|
||||
(not (in non-atomic-types (type x))))
|
||||
|
||||
# C style macros and functions for imperative sugar. No bitwise though.
|
||||
(defn inc "Returns x + 1." [x] (+ x 1))
|
||||
@@ -158,7 +161,7 @@
|
||||
(def ,v ,x)
|
||||
(if ,v
|
||||
,v
|
||||
(,error ,(if err err "assert failure")))))
|
||||
(,error ,(if err err (string/format "assert failure in %j" x))))))
|
||||
|
||||
(defn errorf
|
||||
"A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
|
||||
@@ -606,13 +609,20 @@
|
||||
See `loop` for details.``
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
~(do (def ,$accum @[]) (loop ,head (array/push ,$accum (do ,;body))) ,$accum))
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro tabseq
|
||||
``Similar to `loop`, but accumulates key value pairs into a table.
|
||||
See `loop` for details.``
|
||||
[head key-body & value-body]
|
||||
(def $accum (gensym))
|
||||
~(do (def ,$accum @{}) (loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
|
||||
|
||||
(defmacro generate
|
||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See `loop` for details.``
|
||||
[head & body]
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
||||
@@ -827,15 +837,15 @@
|
||||
a)
|
||||
|
||||
(defn sort
|
||||
``Sort `ind` in-place, and return it. Uses quick-sort and is not a stable sort.
|
||||
``Sorts `ind` in-place, and returns it. Uses quick-sort and is not a stable sort.
|
||||
If a `before?` comparator function is provided, sorts elements using that,
|
||||
otherwise uses `<`.``
|
||||
[ind &opt before?]
|
||||
(sort-help ind 0 (- (length ind) 1) (or before? <)))
|
||||
|
||||
(defn sort-by
|
||||
``Returns `ind` sorted by calling
|
||||
a function `f` on each element and comparing the result with `<`.``
|
||||
``Sorts `ind` in-place by calling a function `f` on each element and
|
||||
comparing the result with `<`.``
|
||||
[f ind]
|
||||
(sort ind (fn [x y] (< (f x) (f y)))))
|
||||
|
||||
@@ -1737,7 +1747,7 @@
|
||||
* tuple -- a tuple pattern will match if its first element matches, and the
|
||||
following elements are treated as predicates and are true.
|
||||
|
||||
* `\_` symbol -- the last special case is the `\_` symbol, which is a wildcard
|
||||
* `_` symbol -- the last special case is the `_` symbol, which is a wildcard
|
||||
that will match any value without creating a binding.
|
||||
|
||||
While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
|
||||
@@ -2053,8 +2063,9 @@
|
||||
ret)
|
||||
|
||||
(defn all
|
||||
``Returns true if all `xs` are truthy, otherwise the result of first
|
||||
falsey predicate value, `(pred x)`.``
|
||||
``Returns true if `(pred item)` returns a truthy value for every item in `xs`.
|
||||
Otherwise, returns the first falsey `(pred item)` result encountered.
|
||||
Returns true if `xs` is empty.``
|
||||
[pred xs]
|
||||
(var ret true)
|
||||
(loop [x :in xs :while ret] (set ret (pred x)))
|
||||
@@ -2165,7 +2176,7 @@
|
||||
|(+ $ $) # use pipe reader macro for terse function literals.
|
||||
|(+ $&) # variadic functions
|
||||
```
|
||||
[arg]
|
||||
[arg &opt name]
|
||||
(var max-param-seen -1)
|
||||
(var vararg false)
|
||||
(defn saw-special-arg
|
||||
@@ -2191,8 +2202,9 @@
|
||||
x))
|
||||
x))
|
||||
(def expanded (macex arg on-binding))
|
||||
(def name-splice (if name [name] []))
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2521,7 +2533,7 @@
|
||||
(in env :exit-value env))
|
||||
|
||||
(defn quit
|
||||
``Tries to exit from the current repl or context. Does not always exit the application.
|
||||
``Tries to exit from the current repl or run-context. Does not always exit the application.
|
||||
Works by setting the :exit dynamic binding to true. Passing a non-nil `value` here will cause the outer
|
||||
run-context to return that value.``
|
||||
[&opt value]
|
||||
@@ -2529,36 +2541,11 @@
|
||||
(setdyn :exit-value value)
|
||||
nil)
|
||||
|
||||
(defn eval-string
|
||||
``Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[str]
|
||||
(var state (string str))
|
||||
(defn chunks [buf _]
|
||||
(def ret state)
|
||||
(set state nil)
|
||||
(when ret
|
||||
(buffer/push-string buf str)
|
||||
(buffer/push-string buf "\n")))
|
||||
(var returnval nil)
|
||||
(run-context {:chunks chunks
|
||||
:on-compile-error (fn compile-error [msg errf &]
|
||||
(error (string "compile error: " msg)))
|
||||
:on-parse-error (fn parse-error [p x]
|
||||
(error (string "parse error: " (:error p))))
|
||||
:fiber-flags :i
|
||||
:on-status (fn on-status [f val]
|
||||
(if-not (= (fiber/status f) :dead)
|
||||
(error val))
|
||||
(set returnval val))
|
||||
:source :eval-string})
|
||||
returnval)
|
||||
|
||||
(defn eval
|
||||
``Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[form]
|
||||
(def res (compile form (fiber/getenv (fiber/current)) :eval))
|
||||
(def res (compile form nil :eval))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(error (get res :error))))
|
||||
@@ -2569,6 +2556,8 @@
|
||||
[str]
|
||||
(let [p (parser/new)]
|
||||
(parser/consume p str)
|
||||
(if (= :error (parser/status p))
|
||||
(error (parser/error p)))
|
||||
(parser/eof p)
|
||||
(if (parser/has-more p)
|
||||
(parser/produce p)
|
||||
@@ -2583,6 +2572,8 @@
|
||||
(let [p (parser/new)
|
||||
ret @[]]
|
||||
(parser/consume p str)
|
||||
(if (= :error (parser/status p))
|
||||
(error (parser/error p)))
|
||||
(parser/eof p)
|
||||
(while (parser/has-more p)
|
||||
(array/push ret (parser/produce p)))
|
||||
@@ -2590,6 +2581,14 @@
|
||||
(error (parser/error p))
|
||||
ret)))
|
||||
|
||||
(defn eval-string
|
||||
``Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[str]
|
||||
(var ret nil)
|
||||
(each x (parse-all str) (set ret (eval x)))
|
||||
ret)
|
||||
|
||||
(def load-image-dict
|
||||
``A table used in combination with `unmarshal` to unmarshal byte sequences created
|
||||
by `make-image`, such that `(load-image bytes)` is the same as `(unmarshal bytes load-image-dict)`.``
|
||||
@@ -2629,9 +2628,10 @@
|
||||
[image]
|
||||
(unmarshal image load-image-dict))
|
||||
|
||||
(defn- check-dyn-relative [x] (if (string/has-prefix? "@" x) x))
|
||||
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
|
||||
(defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
|
||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
|
||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||
|
||||
(def module/cache
|
||||
@@ -2665,6 +2665,8 @@
|
||||
(defn- find-prefix
|
||||
[pre]
|
||||
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
|
||||
(def dyn-index (find-prefix ":@all:"))
|
||||
(array/insert module/paths dyn-index [(string ":@all:" ext) loader check-dyn-relative])
|
||||
(def all-index (find-prefix ".:all:"))
|
||||
(array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
|
||||
(def sys-index (find-prefix ":sys:"))
|
||||
@@ -2762,19 +2764,20 @@
|
||||
(put nextenv :fiber fiber)
|
||||
(put nextenv :debug-level level)
|
||||
(put nextenv :signal (fiber/last-value fiber))
|
||||
|
||||
(merge-into nextenv debugger-env)
|
||||
(defn debugger-chunks [buf p]
|
||||
(def status (:state p :delimiters))
|
||||
(def c ((:where p) 0))
|
||||
(def prpt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prpt buf nextenv))
|
||||
(print "entering debug[" level "] - (quit) to exit")
|
||||
(eprint "entering debug[" level "] - (quit) to exit")
|
||||
(flush)
|
||||
(run-context
|
||||
{:chunks debugger-chunks
|
||||
:on-status (debugger-on-status-var nextenv (+ 1 level) true)
|
||||
:env nextenv})
|
||||
(print "exiting debug[" level "]")
|
||||
(eprint "exiting debug[" level "]")
|
||||
(flush)
|
||||
(nextenv :resume-value))
|
||||
|
||||
@@ -3013,7 +3016,7 @@
|
||||
:italics ["*" "*"]
|
||||
:bold ["**" "**"]}))
|
||||
(def modes @{})
|
||||
(defn toggle [mode]
|
||||
(defn toggle-mode [mode]
|
||||
(def active (get modes mode))
|
||||
(def delims (get delimiters mode))
|
||||
(put modes mode (not active))
|
||||
@@ -3123,7 +3126,7 @@
|
||||
(def token @"")
|
||||
(var token-length 0)
|
||||
(defn delim [mode]
|
||||
(def d (toggle mode))
|
||||
(def d (toggle-mode mode))
|
||||
(if-not has-color (+= token-length (length d)))
|
||||
(buffer/push token d))
|
||||
(defn endtoken []
|
||||
@@ -3134,16 +3137,18 @@
|
||||
(def b (get line i))
|
||||
(cond
|
||||
(or (= b (chr "\n")) (= b (chr " "))) (endtoken)
|
||||
(= b (chr `\`)) (do
|
||||
(++ token-length)
|
||||
(buffer/push token (get line (++ i))))
|
||||
(= b (chr "_")) (delim :underline)
|
||||
(= b (chr "`")) (delim :code)
|
||||
(= b (chr "*"))
|
||||
(if (= (chr "*") (get line (+ i 1)))
|
||||
(do (++ i)
|
||||
(delim :bold))
|
||||
(delim :italics))
|
||||
(not (modes :code)) (cond
|
||||
(= b (chr `\`)) (do
|
||||
(++ token-length)
|
||||
(buffer/push token (get line (++ i))))
|
||||
(= b (chr "_")) (delim :underline)
|
||||
(= b (chr "*"))
|
||||
(if (= (chr "*") (get line (+ i 1)))
|
||||
(do (++ i)
|
||||
(delim :bold))
|
||||
(delim :italics))
|
||||
(do (++ token-length) (buffer/push token b)))
|
||||
(do (++ token-length) (buffer/push token b))))
|
||||
(endtoken)
|
||||
(tuple/slice tokens))
|
||||
@@ -3368,11 +3373,16 @@
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
"Show a stack frame."
|
||||
"Show a stack frame"
|
||||
[&opt n]
|
||||
(def stack (debug/stack (.fiber)))
|
||||
(in stack (or n 0)))
|
||||
|
||||
(defn .locals
|
||||
"Show local bindings"
|
||||
[&opt n]
|
||||
(get (.frame n) :locals))
|
||||
|
||||
(defn .fn
|
||||
"Get the current function."
|
||||
[&opt n]
|
||||
@@ -3553,7 +3563,7 @@
|
||||
(ev/go (fn _call [&] (f ;args))))
|
||||
|
||||
(defmacro ev/spawn
|
||||
"Run some code in a new fiber. This is shorthand for `(ev/call (fn [] ;body))`."
|
||||
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
||||
[& body]
|
||||
~(,ev/go (fn _spawn [&] ,;body)))
|
||||
|
||||
@@ -3577,13 +3587,18 @@
|
||||
(,ev/deadline ,deadline nil ,f)
|
||||
(,resume ,f))))
|
||||
|
||||
(defn- cancel-all [fibers reason] (each f fibers (ev/cancel f reason) (put fibers f nil)))
|
||||
|
||||
(defn- wait-for-fibers
|
||||
[chan fibers]
|
||||
(repeat (length fibers)
|
||||
(def [sig fiber] (ev/take chan))
|
||||
(unless (= sig :ok)
|
||||
(each f fibers (ev/cancel f "sibling canceled"))
|
||||
(propagate (fiber/last-value fiber) fiber))))
|
||||
(defer (cancel-all fibers "parent canceled")
|
||||
(repeat (length fibers)
|
||||
(def [sig fiber] (ev/take chan))
|
||||
(if (= sig :ok)
|
||||
(put fibers fiber nil)
|
||||
(do
|
||||
(cancel-all fibers "sibling canceled")
|
||||
(propagate (fiber/last-value fiber) fiber))))))
|
||||
|
||||
(defmacro ev/gather
|
||||
``
|
||||
@@ -3591,13 +3606,16 @@
|
||||
Returns the gathered results in an array.
|
||||
``
|
||||
[& bodies]
|
||||
(with-syms [chan res]
|
||||
(with-syms [chan res fset ftemp]
|
||||
~(do
|
||||
(def ,fset @{})
|
||||
(def ,chan (,ev/chan))
|
||||
(def ,res @[])
|
||||
(,wait-for-fibers ,chan
|
||||
,(seq [[i body] :pairs bodies]
|
||||
~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
|
||||
,;(seq [[i body] :pairs bodies]
|
||||
~(do
|
||||
(def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
|
||||
(,put ,fset ,ftemp ,ftemp)))
|
||||
(,wait-for-fibers ,chan ,fset)
|
||||
,res))))
|
||||
|
||||
(compwhen (dyn 'net/listen)
|
||||
@@ -3657,6 +3675,7 @@
|
||||
(defmacro ffi/defbind
|
||||
"Generate bindings for native functions in a convenient manner."
|
||||
[name ret-type & body]
|
||||
(def real-ret-type (eval ret-type))
|
||||
(def meta (slice body 0 -2))
|
||||
(def arg-pairs (partition 2 (last body)))
|
||||
(def formal-args (map 0 arg-pairs))
|
||||
@@ -3668,9 +3687,9 @@
|
||||
:map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found"))
|
||||
(def raw-symbol (ms name))
|
||||
(defn make-sig []
|
||||
(ffi/signature :default ret-type ;computed-type-args))
|
||||
(ffi/signature :default real-ret-type ;computed-type-args))
|
||||
(defn make-ptr []
|
||||
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find symbol"))
|
||||
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
|
||||
(if lazy
|
||||
~(defn ,name ,;meta [,;formal-args]
|
||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
||||
@@ -3871,7 +3890,7 @@
|
||||
"E" (fn E-switch [i &]
|
||||
(set no-file false)
|
||||
(def subargs (array/slice args (+ i 2)))
|
||||
(def src ~|,(parse (in args (+ i 1))))
|
||||
(def src ~(short-fn ,(parse (in args (+ i 1))) E-expression))
|
||||
(def thunk (compile src))
|
||||
(if (function? thunk)
|
||||
((thunk) ;subargs)
|
||||
@@ -3926,7 +3945,7 @@
|
||||
compile-only (flycheck stdin :source :stdin :exit exit-on-error)
|
||||
(do
|
||||
(if-not quiet
|
||||
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
|
||||
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
|
||||
(flush)
|
||||
(defn getprompt [p]
|
||||
(def [line] (parser/where p))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 23
|
||||
#define JANET_VERSION_MINOR 27
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.23.0"
|
||||
#define JANET_VERSION "1.27.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -33,6 +33,8 @@
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
/* #define JANET_NO_THREADS */
|
||||
/* #define JANET_NO_FFI */
|
||||
/* #define JANET_NO_FFI_JIT */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_DEBUG */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -31,6 +31,8 @@
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <stdatomic.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -96,11 +98,11 @@ size_t janet_os_rwlock_size(void) {
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement(&ab->gc.data.refcount);
|
||||
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return InterlockedDecrement(&ab->gc.data.refcount);
|
||||
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -187,7 +187,11 @@ static void janet_asm_longjmp(JanetAssembler *a) {
|
||||
|
||||
/* Throw some kind of assembly error */
|
||||
static void janet_asm_error(JanetAssembler *a, const char *message) {
|
||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||
if (a->errindex < 0) {
|
||||
a->errmessage = janet_formatc("%s", message);
|
||||
} else {
|
||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||
}
|
||||
janet_asm_longjmp(a);
|
||||
}
|
||||
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
|
||||
@@ -516,6 +520,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
#endif
|
||||
if (NULL != a.parent) {
|
||||
janet_asm_deinit(&a);
|
||||
a.parent->errmessage = a.errmessage;
|
||||
janet_asm_longjmp(a.parent);
|
||||
}
|
||||
result.funcdef = NULL;
|
||||
@@ -601,6 +606,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
|
||||
/* Parse sub funcdefs */
|
||||
x = janet_get1(s, janet_ckeywordv("closures"));
|
||||
if (janet_checktype(x, JANET_NIL)) {
|
||||
x = janet_get1(s, janet_ckeywordv("defs"));
|
||||
}
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
@@ -713,10 +721,63 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
}
|
||||
|
||||
/* Set symbolmap */
|
||||
def->symbolmap = NULL;
|
||||
def->symbolmap_length = 0;
|
||||
x = janet_get1(s, janet_ckeywordv("symbolmap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->symbolmap_length = count;
|
||||
def->symbolmap = janet_malloc(sizeof(JanetSymbolMap) * (size_t)count);
|
||||
if (NULL == def->symbolmap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
JanetSymbolMap ss;
|
||||
if (!janet_checktype(entry, JANET_TUPLE)) {
|
||||
janet_asm_error(&a, "expected tuple");
|
||||
}
|
||||
tup = janet_unwrap_tuple(entry);
|
||||
if (janet_keyeq(tup[0], "upvalue")) {
|
||||
ss.birth_pc = UINT32_MAX;
|
||||
} else if (!janet_checkint(tup[0])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
} else {
|
||||
ss.birth_pc = janet_unwrap_integer(tup[0]);
|
||||
}
|
||||
if (!janet_checkint(tup[1])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
if (!janet_checkint(tup[2])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
if (!janet_checktype(tup[3], JANET_SYMBOL)) {
|
||||
janet_asm_error(&a, "expected symbol");
|
||||
}
|
||||
ss.death_pc = janet_unwrap_integer(tup[1]);
|
||||
ss.slot_index = janet_unwrap_integer(tup[2]);
|
||||
ss.symbol = janet_unwrap_symbol(tup[3]);
|
||||
def->symbolmap[i] = ss;
|
||||
}
|
||||
}
|
||||
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
|
||||
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
x = janet_get1(s, janet_ckeywordv("environments"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->environments_length = count;
|
||||
if (def->environments_length) {
|
||||
def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
}
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
if (!janet_checkint(arr[i])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
def->environments[i] = janet_unwrap_integer(arr[i]);
|
||||
}
|
||||
}
|
||||
if (def->environments_length && NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -865,6 +926,30 @@ static Janet janet_disasm_slotcount(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->slotcount);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
|
||||
if (def->symbolmap == NULL) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
JanetArray *symbolslots = janet_array(def->symbolmap_length);
|
||||
Janet upvaluekw = janet_ckeywordv("upvalue");
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
JanetSymbolMap ss = def->symbolmap[i];
|
||||
Janet *t = janet_tuple_begin(4);
|
||||
if (ss.birth_pc == UINT32_MAX) {
|
||||
t[0] = upvaluekw;
|
||||
} else {
|
||||
t[0] = janet_wrap_integer(ss.birth_pc);
|
||||
}
|
||||
t[1] = janet_wrap_integer(ss.death_pc);
|
||||
t[2] = janet_wrap_integer(ss.slot_index);
|
||||
t[3] = janet_wrap_symbol(ss.symbol);
|
||||
symbolslots->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
symbolslots->count = def->symbolmap_length;
|
||||
return janet_wrap_array(symbolslots);
|
||||
}
|
||||
|
||||
|
||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
@@ -944,6 +1029,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
|
||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
|
||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
|
||||
@@ -961,7 +1047,7 @@ JANET_CORE_FN(cfun_asm,
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
janet_panics(res.error);
|
||||
janet_panics(res.error ? res.error : janet_cstring("invalid assembly"));
|
||||
}
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
}
|
||||
@@ -980,6 +1066,7 @@ JANET_CORE_FN(cfun_disasm,
|
||||
"* :source - name of source file that this function was compiled from.\n"
|
||||
"* :name - name of function.\n"
|
||||
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
||||
"* :symbolmap - all symbols and their slots.\n"
|
||||
"* :constants - an array of constants referenced by this function.\n"
|
||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -28,8 +28,15 @@
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Allow for managed buffers that cannot realloc/free their backing memory */
|
||||
static void janet_buffer_can_realloc(JanetBuffer *buffer) {
|
||||
if (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) {
|
||||
janet_panic("buffer cannot reallocate foreign memory");
|
||||
}
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity < 4) capacity = 4;
|
||||
janet_gcpressure(capacity);
|
||||
@@ -43,15 +50,37 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
janet_buffer_init_impl(buffer, capacity);
|
||||
buffer->gc.data.next = NULL;
|
||||
buffer->gc.flags = JANET_MEM_DISABLED;
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Initialize an unmanaged buffer */
|
||||
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
|
||||
if (count < 0) janet_panic("count < 0");
|
||||
if (capacity < count) janet_panic("capacity < count");
|
||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||
buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
|
||||
buffer->capacity = capacity;
|
||||
buffer->count = count;
|
||||
buffer->data = (uint8_t *) memory;
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Deinitialize a buffer (free data memory) */
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
janet_free(buffer->data);
|
||||
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||
janet_free(buffer->data);
|
||||
}
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer(int32_t capacity) {
|
||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||
return janet_buffer_init(buffer, capacity);
|
||||
return janet_buffer_init_impl(buffer, capacity);
|
||||
}
|
||||
|
||||
/* Ensure that the buffer has enough internal capacity */
|
||||
@@ -59,6 +88,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
uint8_t *new_data;
|
||||
uint8_t *old = buffer->data;
|
||||
if (capacity <= buffer->capacity) return;
|
||||
janet_buffer_can_realloc(buffer);
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
@@ -91,6 +121,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
janet_buffer_can_realloc(buffer);
|
||||
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
||||
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
@@ -212,6 +243,7 @@ JANET_CORE_FN(cfun_buffer_trim,
|
||||
"modified buffer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
janet_buffer_can_realloc(buffer);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||
@@ -275,17 +307,8 @@ JANET_CORE_FN(cfun_buffer_chars,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push,
|
||||
"(buffer/push buffer & xs)",
|
||||
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
||||
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
||||
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
|
||||
for (int32_t i = argc_offset; i < argc; i++) {
|
||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||
} else {
|
||||
@@ -297,6 +320,36 @@ JANET_CORE_FN(cfun_buffer_push,
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_at,
|
||||
"(buffer/push-at buffer index & xs)",
|
||||
"Same as buffer/push, but inserts new data at index `index`.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t index = janet_getinteger(argv, 1);
|
||||
int32_t old_count = buffer->count;
|
||||
if (index < 0 || index > old_count) {
|
||||
janet_panicf("index out of range [0, %d)", old_count);
|
||||
}
|
||||
buffer->count = index;
|
||||
buffer_push_impl(buffer, argv, 2, argc);
|
||||
if (buffer->count < old_count) {
|
||||
buffer->count = old_count;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push,
|
||||
"(buffer/push buffer & xs)",
|
||||
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
||||
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
||||
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
buffer_push_impl(buffer, argv, 1, argc);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -442,7 +495,7 @@ JANET_CORE_FN(cfun_buffer_blit,
|
||||
JANET_CORE_FN(cfun_buffer_format,
|
||||
"(buffer/format buffer format & args)",
|
||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||
" the modified buffer.") {
|
||||
"the modified buffer.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||
@@ -460,6 +513,7 @@ void janet_lib_buffer(JanetTable *env) {
|
||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
||||
JANET_CORE_REG("buffer/push", cfun_buffer_push),
|
||||
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
||||
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
|
||||
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -218,6 +218,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->closure_bitset = NULL;
|
||||
def->flags = 0;
|
||||
def->slotcount = 0;
|
||||
def->symbolmap = NULL;
|
||||
def->arity = 0;
|
||||
def->min_arity = 0;
|
||||
def->max_arity = INT32_MAX;
|
||||
@@ -229,6 +230,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->constants_length = 0;
|
||||
def->bytecode_length = 0;
|
||||
def->environments_length = 0;
|
||||
def->symbolmap_length = 0;
|
||||
return def;
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -260,7 +260,7 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INTTYPES
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_s64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
@@ -272,7 +272,7 @@ int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
}
|
||||
|
||||
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INTTYPES
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_u64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -93,10 +93,14 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
/* Add a slot to a scope with a symbol associated with it (def or var). */
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||
SymPair sp;
|
||||
int32_t cnt = janet_v_count(c->buffer);
|
||||
sp.sym = sym;
|
||||
sp.sym2 = sym;
|
||||
sp.slot = s;
|
||||
sp.keep = 0;
|
||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||
sp.death_pc = UINT32_MAX;
|
||||
janet_v_push(c->scope->syms, sp);
|
||||
}
|
||||
|
||||
@@ -159,21 +163,27 @@ void janetc_popscope(JanetCompiler *c) {
|
||||
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
|
||||
newscope->flags |= JANET_SCOPE_CLOSURE;
|
||||
}
|
||||
if (newscope->ra.max < oldscope->ra.max)
|
||||
if (newscope->ra.max < oldscope->ra.max) {
|
||||
newscope->ra.max = oldscope->ra.max;
|
||||
|
||||
/* Keep upvalue slots */
|
||||
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
||||
SymPair pair = oldscope->syms[i];
|
||||
if (pair.keep) {
|
||||
/* The variable should not be lexically accessible */
|
||||
pair.sym = NULL;
|
||||
janet_v_push(newscope->syms, pair);
|
||||
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
|
||||
}
|
||||
}
|
||||
|
||||
/* Keep upvalue slots and symbols for debugging. */
|
||||
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
||||
SymPair pair = oldscope->syms[i];
|
||||
/* The variable should not be lexically accessible */
|
||||
pair.sym = NULL;
|
||||
if (pair.death_pc == UINT32_MAX) {
|
||||
pair.death_pc = (uint32_t) janet_v_count(c->buffer);
|
||||
}
|
||||
if (pair.keep) {
|
||||
/* The variable should also not be included in the locals */
|
||||
pair.sym2 = NULL;
|
||||
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
|
||||
}
|
||||
janet_v_push(newscope->syms, pair);
|
||||
}
|
||||
}
|
||||
|
||||
/* Free the old scope */
|
||||
janet_v_free(oldscope->consts);
|
||||
janet_v_free(oldscope->syms);
|
||||
@@ -334,6 +344,7 @@ found:
|
||||
}
|
||||
|
||||
/* non-local scope needs to expose its environment */
|
||||
JanetScope *original_scope = scope;
|
||||
pair->keep = 1;
|
||||
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
|
||||
scope = scope->parent;
|
||||
@@ -355,7 +366,7 @@ found:
|
||||
/* Check if scope already has env. If so, break */
|
||||
len = janet_v_count(scope->envs);
|
||||
for (j = 0; j < len; j++) {
|
||||
if (scope->envs[j] == envindex) {
|
||||
if (scope->envs[j].envindex == envindex) {
|
||||
scopefound = 1;
|
||||
envindex = j;
|
||||
break;
|
||||
@@ -364,7 +375,10 @@ found:
|
||||
/* Add the environment if it is not already referenced */
|
||||
if (!scopefound) {
|
||||
len = janet_v_count(scope->envs);
|
||||
janet_v_push(scope->envs, envindex);
|
||||
JanetEnvRef ref;
|
||||
ref.envindex = envindex;
|
||||
ref.scope = original_scope;
|
||||
janet_v_push(scope->envs, ref);
|
||||
envindex = len;
|
||||
}
|
||||
}
|
||||
@@ -868,7 +882,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
|
||||
/* Copy envs */
|
||||
def->environments_length = janet_v_count(scope->envs);
|
||||
def->environments = janet_v_flatten(scope->envs);
|
||||
def->environments = janet_malloc(sizeof(int32_t) * def->environments_length);
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
def->environments[i] = scope->envs[i].envindex;
|
||||
}
|
||||
|
||||
def->constants_length = janet_v_count(scope->consts);
|
||||
def->constants = janet_v_flatten(scope->consts);
|
||||
@@ -923,6 +940,50 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->closure_bitset = chunks;
|
||||
}
|
||||
|
||||
/* Capture symbol to local mapping */
|
||||
JanetSymbolMap *locals = NULL;
|
||||
|
||||
/* Symbol -> upvalue mapping */
|
||||
JanetScope *top = c->scope;
|
||||
while (top->parent) top = top->parent;
|
||||
for (JanetScope *s = top; s != NULL; s = s->child) {
|
||||
for (int32_t j = 0; j < janet_v_count(scope->envs); j++) {
|
||||
JanetEnvRef ref = scope->envs[j];
|
||||
JanetScope *upscope = ref.scope;
|
||||
if (upscope != s) continue;
|
||||
for (int32_t i = 0; i < janet_v_count(upscope->syms); i++) {
|
||||
SymPair pair = upscope->syms[i];
|
||||
if (pair.sym2) {
|
||||
JanetSymbolMap jsm;
|
||||
jsm.birth_pc = UINT32_MAX;
|
||||
jsm.death_pc = j;
|
||||
jsm.slot_index = pair.slot.index;
|
||||
jsm.symbol = pair.sym2;
|
||||
janet_v_push(locals, jsm);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Symbol -> slot mapping */
|
||||
for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
|
||||
SymPair pair = scope->syms[i];
|
||||
if (pair.sym2) {
|
||||
if (pair.death_pc == UINT32_MAX) {
|
||||
pair.death_pc = def->bytecode_length;
|
||||
}
|
||||
JanetSymbolMap jsm;
|
||||
jsm.birth_pc = pair.birth_pc;
|
||||
jsm.death_pc = pair.death_pc;
|
||||
jsm.slot_index = pair.slot.index;
|
||||
jsm.symbol = pair.sym2;
|
||||
janet_v_push(locals, jsm);
|
||||
}
|
||||
}
|
||||
def->symbolmap_length = janet_v_count(locals);
|
||||
def->symbolmap = janet_v_flatten(locals);
|
||||
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
|
||||
|
||||
/* Pop the scope */
|
||||
janetc_popscope(c);
|
||||
|
||||
@@ -996,7 +1057,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
JANET_CORE_FN(cfun,
|
||||
JANET_CORE_FN(cfun_compile,
|
||||
"(compile ast &opt env source lints)",
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
@@ -1005,7 +1066,8 @@ JANET_CORE_FN(cfun,
|
||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||
"Each message will be a tuple of the form `(level line col message)`.") {
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
|
||||
? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm.fiber->env = env;
|
||||
@@ -1017,11 +1079,12 @@ JANET_CORE_FN(cfun,
|
||||
source = janet_unwrap_string(x);
|
||||
} else if (janet_checktype(x, JANET_KEYWORD)) {
|
||||
source = janet_unwrap_keyword(x);
|
||||
} else {
|
||||
} else if (!janet_checktype(x, JANET_NIL)) {
|
||||
janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
|
||||
}
|
||||
}
|
||||
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||
JanetArray *lints = (argc >= 4 && !janet_checktype(argv[3], JANET_NIL))
|
||||
? janet_getarray(argv, 3) : NULL;
|
||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
@@ -1043,7 +1106,7 @@ JANET_CORE_FN(cfun,
|
||||
|
||||
void janet_lib_compile(JanetTable *env) {
|
||||
JanetRegExt cfuns[] = {
|
||||
JANET_CORE_REG("compile", cfun),
|
||||
JANET_CORE_REG("compile", cfun_compile),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -111,13 +111,21 @@ struct JanetSlot {
|
||||
typedef struct SymPair {
|
||||
JanetSlot slot;
|
||||
const uint8_t *sym;
|
||||
const uint8_t *sym2;
|
||||
int keep;
|
||||
uint32_t birth_pc;
|
||||
uint32_t death_pc;
|
||||
} SymPair;
|
||||
|
||||
typedef struct JanetEnvRef {
|
||||
int32_t envindex;
|
||||
JanetScope *scope;
|
||||
} JanetEnvRef;
|
||||
|
||||
/* A lexical scope during compilation */
|
||||
struct JanetScope {
|
||||
|
||||
/* For debugging */
|
||||
/* For debugging the compiler */
|
||||
const char *name;
|
||||
|
||||
/* Scopes are doubly linked list */
|
||||
@@ -133,7 +141,7 @@ struct JanetScope {
|
||||
/* FuncDefs */
|
||||
JanetFuncDef **defs;
|
||||
|
||||
/* Regsiter allocator */
|
||||
/* Register allocator */
|
||||
JanetcRegisterAllocator ra;
|
||||
|
||||
/* Upvalue allocator */
|
||||
@@ -142,7 +150,7 @@ struct JanetScope {
|
||||
/* Referenced closure environments. The values at each index correspond
|
||||
* to which index to get the environment from in the parent. The environment
|
||||
* that corresponds to the direct parent's stack will always have value 0. */
|
||||
int32_t *envs;
|
||||
JanetEnvRef *envs;
|
||||
|
||||
int32_t bytecode_start;
|
||||
int flags;
|
||||
@@ -227,7 +235,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
|
||||
/* Get a bunch of slots for function arguments */
|
||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
||||
|
||||
/* Push slots load via janetc_toslots. */
|
||||
/* Push slots loaded via janetc_toslots. */
|
||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
||||
|
||||
/* Free slots loaded via janetc_toslots */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -43,6 +43,7 @@ extern size_t janet_core_image_size;
|
||||
#endif
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_DYNAMIC_MODULES);
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
JanetModule init;
|
||||
@@ -111,7 +112,10 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||
"This takes in a path (the argument to require) and a template string, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"* :all: -- the value of path verbatim\n\n"
|
||||
"* :all: -- the value of path verbatim.\n\n"
|
||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
|
||||
" the first path segment is replaced with a dynamic binding\n"
|
||||
" `(dyn <first path segment as keyword>)`.\n\n"
|
||||
"* :cur: -- the current file, or (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory containing the current file\n\n"
|
||||
"* :name: -- the name component of path, with extension if given\n\n"
|
||||
@@ -157,6 +161,21 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||
if (strncmp(template + i, ":all:", 5) == 0) {
|
||||
janet_buffer_push_cstring(out, input);
|
||||
i += 4;
|
||||
} else if (strncmp(template + i, ":@all:", 6) == 0) {
|
||||
if (input[0] == '@') {
|
||||
const char *p = input;
|
||||
while (*p && !is_path_sep(*p)) p++;
|
||||
size_t len = p - input - 1;
|
||||
char *str = janet_smalloc(len + 1);
|
||||
memcpy(str, input + 1, len);
|
||||
str[len] = '\0';
|
||||
janet_formatb(out, "%V", janet_dyn(str));
|
||||
janet_sfree(str);
|
||||
janet_buffer_push_cstring(out, p);
|
||||
} else {
|
||||
janet_buffer_push_cstring(out, input);
|
||||
}
|
||||
i += 5;
|
||||
} else if (strncmp(template + i, ":cur:", 5) == 0) {
|
||||
janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
|
||||
i += 4;
|
||||
@@ -614,27 +633,97 @@ JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload x. ") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int sig;
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
if (janet_checkint(argv[0])) {
|
||||
int32_t s = janet_unwrap_integer(argv[0]);
|
||||
if (s < 0 || s > 9) {
|
||||
janet_panicf("expected user signal between 0 and 9, got %d", s);
|
||||
}
|
||||
sig = JANET_SIGNAL_USER0 + s;
|
||||
janet_signalv(JANET_SIGNAL_USER0 + s, payload);
|
||||
} else {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 0);
|
||||
if (!janet_cstrcmp(kw, "yield")) {
|
||||
sig = JANET_SIGNAL_YIELD;
|
||||
} else if (!janet_cstrcmp(kw, "error")) {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
||||
sig = JANET_SIGNAL_DEBUG;
|
||||
} else {
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
for (unsigned i = 0; i < sizeof(janet_signal_names) / sizeof(char *); i++) {
|
||||
if (!janet_cstrcmp(kw, janet_signal_names[i])) {
|
||||
janet_signalv((JanetSignal) i, payload);
|
||||
}
|
||||
}
|
||||
}
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
janet_signalv(sig, payload);
|
||||
janet_panicf("unknown signal %v", argv[0]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_memcmp,
|
||||
"(memcmp a b &opt len offset-a offset-b)",
|
||||
"Compare memory. Takes two byte sequences `a` and `b`, and "
|
||||
"return 0 if they have identical contents, a negative integer if a is less than b, "
|
||||
"and a positive integer if a is greater than b. Optionally take a length and offsets "
|
||||
"to compare slices of the bytes sequences.") {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetByteView a = janet_getbytes(argv, 0);
|
||||
JanetByteView b = janet_getbytes(argv, 1);
|
||||
int32_t len = janet_optnat(argv, argc, 2, a.len < b.len ? a.len : b.len);
|
||||
int32_t offset_a = janet_optnat(argv, argc, 3, 0);
|
||||
int32_t offset_b = janet_optnat(argv, argc, 4, 0);
|
||||
if (offset_a + len > a.len) janet_panicf("invalid offset-a: %d", offset_a);
|
||||
if (offset_b + len > b.len) janet_panicf("invalid offset-b: %d", offset_b);
|
||||
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
|
||||
}
|
||||
|
||||
typedef struct SandboxOption {
|
||||
const char *name;
|
||||
uint32_t flag;
|
||||
} SandboxOption;
|
||||
|
||||
static const SandboxOption sandbox_options[] = {
|
||||
{"all", JANET_SANDBOX_ALL},
|
||||
{"env", JANET_SANDBOX_ENV},
|
||||
{"ffi", JANET_SANDBOX_FFI},
|
||||
{"fs", JANET_SANDBOX_FS},
|
||||
{"fs-read", JANET_SANDBOX_FS_READ},
|
||||
{"fs-temp", JANET_SANDBOX_FS_TEMP},
|
||||
{"fs-write", JANET_SANDBOX_FS_WRITE},
|
||||
{"hrtime", JANET_SANDBOX_HRTIME},
|
||||
{"modules", JANET_SANDBOX_DYNAMIC_MODULES},
|
||||
{"net", JANET_SANDBOX_NET},
|
||||
{"net-connect", JANET_SANDBOX_NET_CONNECT},
|
||||
{"net-listen", JANET_SANDBOX_NET_LISTEN},
|
||||
{"sandbox", JANET_SANDBOX_SANDBOX},
|
||||
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
||||
{NULL, 0}
|
||||
};
|
||||
|
||||
JANET_CORE_FN(janet_core_sandbox,
|
||||
"(sandbox & forbidden-capabilities)",
|
||||
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
||||
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
||||
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
||||
"* :env - disallow reading and write env variables\n"
|
||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||
"* :fs - disallow access to the file system\n"
|
||||
"* :fs-read - disallow read access to the file system\n"
|
||||
"* :fs-temp - disallow creating temporary files\n"
|
||||
"* :fs-write - disallow write access to the file system\n"
|
||||
"* :hrtime - disallow high-resolution timers\n"
|
||||
"* :modules - disallow load dynamic modules (natives)\n"
|
||||
"* :net - disallow network access\n"
|
||||
"* :net-connect - disallow making outbound network connections\n"
|
||||
"* :net-listen - disallow accepting inbound network connections\n"
|
||||
"* :sandbox - disallow calling this function\n"
|
||||
"* :subprocess - disallow running subprocesses") {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
JanetKeyword kw = janet_getkeyword(argv, i);
|
||||
const SandboxOption *opt = sandbox_options;
|
||||
while (opt->name != NULL) {
|
||||
if (janet_cstrcmp(kw, opt->name) == 0) {
|
||||
flags |= opt->flag;
|
||||
break;
|
||||
}
|
||||
opt++;
|
||||
}
|
||||
if (opt->name == NULL) janet_panicf("unknown capability %v", argv[i]);
|
||||
}
|
||||
janet_sandbox(flags);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
@@ -938,7 +1027,9 @@ static void janet_load_libs(JanetTable *env) {
|
||||
JANET_CORE_REG("nat?", janet_core_check_nat),
|
||||
JANET_CORE_REG("slice", janet_core_slice),
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("memcmp", janet_core_memcmp),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
JANET_CORE_REG("sandbox", janet_core_sandbox),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -131,9 +131,9 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
if (!wrote_error) {
|
||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||
janet_eprintf("%s%s: %s\n",
|
||||
prefix,
|
||||
prefix ? prefix : "",
|
||||
janet_status_names[status],
|
||||
errstr);
|
||||
errstr ? errstr : janet_status_names[status]);
|
||||
wrote_error = 1;
|
||||
}
|
||||
|
||||
@@ -329,6 +329,27 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
/* Add local bindings */
|
||||
if (def->symbolmap) {
|
||||
JanetTable *local_bindings = janet_table(0);
|
||||
for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
|
||||
JanetSymbolMap jsm = def->symbolmap[i];
|
||||
Janet value = janet_wrap_nil();
|
||||
uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
|
||||
if (jsm.birth_pc == UINT32_MAX) {
|
||||
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
|
||||
if (env->offset > 0) {
|
||||
value = env->as.fiber->data[env->offset + jsm.slot_index];
|
||||
} else {
|
||||
value = env->as.values[jsm.slot_index];
|
||||
}
|
||||
} else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
|
||||
value = stack[jsm.slot_index];
|
||||
}
|
||||
janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
|
||||
}
|
||||
janet_table_put(t, janet_ckeywordv("locals"), janet_wrap_table(local_bindings));
|
||||
}
|
||||
}
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
109
src/core/ev.c
109
src/core/ev.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -172,6 +172,9 @@ static JanetTimestamp ts_now(void);
|
||||
|
||||
/* Get current timestamp + an interval (millisecond precision) */
|
||||
static JanetTimestamp ts_delta(JanetTimestamp ts, double delta) {
|
||||
if (isinf(delta)) {
|
||||
return delta < 0 ? ts : INT64_MAX;
|
||||
}
|
||||
ts += (int64_t)round(delta * 1000);
|
||||
return ts;
|
||||
}
|
||||
@@ -535,10 +538,15 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
|
||||
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
|
||||
|
||||
static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
|
||||
Janet tup[2];
|
||||
Janet tup[3];
|
||||
tup[0] = janet_ckeywordv(name);
|
||||
tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
||||
if (fiber->env != NULL) {
|
||||
tup[2] = janet_table_get(fiber->env, janet_ckeywordv("task-id"));
|
||||
} else {
|
||||
tup[2] = janet_wrap_nil();
|
||||
}
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 3));
|
||||
}
|
||||
|
||||
/* Common init code */
|
||||
@@ -552,6 +560,10 @@ void janet_ev_init_common(void) {
|
||||
janet_vm.tq_capacity = 0;
|
||||
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
|
||||
janet_rng_seed(&janet_vm.ev_rng, 0);
|
||||
#ifndef JANET_WINDOWS
|
||||
pthread_attr_init(&janet_vm.new_thread_attr);
|
||||
pthread_attr_setdetachstate(&janet_vm.new_thread_attr, PTHREAD_CREATE_DETACHED);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Common deinit code */
|
||||
@@ -561,6 +573,9 @@ void janet_ev_deinit_common(void) {
|
||||
janet_free(janet_vm.listeners);
|
||||
janet_vm.listeners = NULL;
|
||||
janet_table_deinit(&janet_vm.threaded_abstracts);
|
||||
#ifndef JANET_WINDOWS
|
||||
pthread_attr_destroy(&janet_vm.new_thread_attr);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Short hand to yield to event loop */
|
||||
@@ -1170,14 +1185,48 @@ static Janet janet_chanat_next(void *p, Janet key) {
|
||||
return janet_nextmethod(ev_chanat_methods, key);
|
||||
}
|
||||
|
||||
static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetChannel *channel = (JanetChannel *)p;
|
||||
janet_marshal_byte(ctx, channel->closed);
|
||||
janet_marshal_int(ctx, channel->limit);
|
||||
int32_t count = janet_q_count(&channel->items);
|
||||
janet_marshal_int(ctx, count);
|
||||
JanetQueue *items = &channel->items;
|
||||
Janet *data = channel->items.data;
|
||||
if (items->head <= items->tail) {
|
||||
for (int32_t i = items->head; i < items->tail; i++)
|
||||
janet_marshal_janet(ctx, data[i]);
|
||||
} else {
|
||||
for (int32_t i = items->head; i < items->capacity; i++)
|
||||
janet_marshal_janet(ctx, data[i]);
|
||||
for (int32_t i = 0; i < items->tail; i++)
|
||||
janet_marshal_janet(ctx, data[i]);
|
||||
}
|
||||
}
|
||||
|
||||
static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
|
||||
JanetChannel *abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
|
||||
uint8_t is_closed = janet_unmarshal_byte(ctx);
|
||||
int32_t limit = janet_unmarshal_int(ctx);
|
||||
int32_t count = janet_unmarshal_int(ctx);
|
||||
if (count < 0) janet_panic("invalid negative channel count");
|
||||
janet_chan_init(abst, limit, 0);
|
||||
abst->closed = !!is_closed;
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
Janet item = janet_unmarshal_janet(ctx);
|
||||
janet_q_push(&abst->items, &item, sizeof(item));
|
||||
}
|
||||
return abst;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_channel_type = {
|
||||
"core/channel",
|
||||
janet_chanat_gc,
|
||||
janet_chanat_mark,
|
||||
janet_chanat_get,
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
janet_chanat_marshal,
|
||||
janet_chanat_unmarshal,
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
@@ -2033,12 +2082,11 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||
#else
|
||||
init->write_pipe = janet_vm.selfpipe[1];
|
||||
pthread_t waiter_thread;
|
||||
int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
|
||||
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
|
||||
if (err) {
|
||||
janet_free(init);
|
||||
janet_panicf("%s", strerror(err));
|
||||
}
|
||||
pthread_detach(waiter_thread);
|
||||
#endif
|
||||
|
||||
/* Increment ev refcount so we don't quit while waiting for a subprocess */
|
||||
@@ -2167,9 +2215,9 @@ typedef struct {
|
||||
JanetReadMode mode;
|
||||
#ifdef JANET_WINDOWS
|
||||
OVERLAPPED overlapped;
|
||||
DWORD flags;
|
||||
#ifdef JANET_NET
|
||||
WSABUF wbuf;
|
||||
DWORD flags;
|
||||
struct sockaddr from;
|
||||
int fromlen;
|
||||
#endif
|
||||
@@ -2228,7 +2276,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
#ifdef JANET_NET
|
||||
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
|
||||
state->wbuf.len = (ULONG) chunk_size;
|
||||
state->wbuf.buf = state->chunk_buf;
|
||||
state->wbuf.buf = (char *) state->chunk_buf;
|
||||
status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
|
||||
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
|
||||
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
|
||||
@@ -2243,8 +2291,8 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
state->overlapped.Offset = (DWORD) state->bytes_read;
|
||||
|
||||
status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
|
||||
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
|
||||
if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
|
||||
if (!status && (ERROR_IO_PENDING != GetLastError())) {
|
||||
if (GetLastError() == ERROR_BROKEN_PIPE) {
|
||||
if (state->bytes_read) {
|
||||
janet_schedule(s->fiber, janet_wrap_buffer(state->buf));
|
||||
} else {
|
||||
@@ -2396,9 +2444,9 @@ typedef struct {
|
||||
void *dest_abst;
|
||||
#ifdef JANET_WINDOWS
|
||||
OVERLAPPED overlapped;
|
||||
DWORD flags;
|
||||
#ifdef JANET_NET
|
||||
WSABUF wbuf;
|
||||
DWORD flags;
|
||||
#endif
|
||||
#else
|
||||
int flags;
|
||||
@@ -2483,7 +2531,7 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
|
||||
state->overlapped.Offset = (DWORD) 0xFFFFFFFF;
|
||||
state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
|
||||
status = WriteFile(s->stream->handle, bytes, len, NULL, &state->overlapped);
|
||||
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
|
||||
if (!status && (ERROR_IO_PENDING != GetLastError())) {
|
||||
janet_cancel(s->fiber, janet_ev_lasterr());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
@@ -2619,15 +2667,15 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
|
||||
* so we lift from the windows source code and modify for our own version.
|
||||
*/
|
||||
JanetHandle shandle, chandle;
|
||||
UCHAR PipeNameBuffer[MAX_PATH];
|
||||
CHAR PipeNameBuffer[MAX_PATH];
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
sprintf(PipeNameBuffer,
|
||||
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
|
||||
GetCurrentProcessId(),
|
||||
InterlockedIncrement(&PipeSerialNumber));
|
||||
(unsigned int) GetCurrentProcessId(),
|
||||
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
|
||||
|
||||
/* server handle goes to subprocess */
|
||||
shandle = CreateNamedPipeA(
|
||||
@@ -2682,9 +2730,10 @@ error:
|
||||
/* C functions */
|
||||
|
||||
JANET_CORE_FN(cfun_ev_go,
|
||||
"(ev/go fiber &opt value supervisor)",
|
||||
"Put a fiber on the event loop to be resumed later. Optionally pass "
|
||||
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||
"(ev/go fiber-or-fun &opt value supervisor)",
|
||||
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped "
|
||||
"with `fiber/new` first. "
|
||||
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||
"An optional `core/channel` can be provided as a supervisor. When various "
|
||||
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
||||
"If not provided, the new fiber will inherit the current supervisor.") {
|
||||
@@ -2719,6 +2768,8 @@ JANET_CORE_FN(cfun_ev_go,
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
#define JANET_THREAD_SUPERVISOR_FLAG 0x100
|
||||
|
||||
/* For ev/thread - Run an interpreter in the new thread. */
|
||||
static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
JanetBuffer *buffer = (JanetBuffer *) args.argp;
|
||||
@@ -2727,6 +2778,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
uint32_t flags = args.tag;
|
||||
args.tag = 0;
|
||||
janet_init();
|
||||
janet_vm.sandbox_flags = (uint32_t) args.argi;
|
||||
JanetTryState tstate;
|
||||
JanetSignal signal = janet_try(&tstate);
|
||||
if (!signal) {
|
||||
@@ -2741,7 +2793,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
}
|
||||
|
||||
/* Get supervsior */
|
||||
if (flags & 0x8) {
|
||||
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||
Janet sup =
|
||||
janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||
@@ -2793,6 +2845,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
} else {
|
||||
fiber = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
if (flags & 0x8) {
|
||||
if (NULL == fiber->env) fiber->env = janet_table(0);
|
||||
janet_table_put(fiber->env, janet_ckeywordv("task-id"), value);
|
||||
}
|
||||
fiber->supervisor_channel = janet_vm.user;
|
||||
janet_schedule(fiber, value);
|
||||
janet_loop();
|
||||
@@ -2837,6 +2893,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
|
||||
"Otherwise, returns nil. Available flags:\n\n"
|
||||
"* `:n` - return immediately\n"
|
||||
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
|
||||
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
||||
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
||||
janet_arity(argc, 1, 4);
|
||||
@@ -2844,10 +2901,10 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
||||
uint64_t flags = 0;
|
||||
if (argc >= 3) {
|
||||
flags = janet_getflags(argv, 2, "nac");
|
||||
flags = janet_getflags(argv, 2, "nact");
|
||||
}
|
||||
void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
||||
if (NULL != supervisor) flags |= 0x8;
|
||||
if (NULL != supervisor) flags |= JANET_THREAD_SUPERVISOR_FLAG;
|
||||
|
||||
/* Marshal arguments for the new thread. */
|
||||
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
|
||||
@@ -2858,7 +2915,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
if (!(flags & 0x2)) {
|
||||
janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
|
||||
}
|
||||
if (flags & 0x8) {
|
||||
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||
janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE);
|
||||
}
|
||||
if (!(flags & 0x4)) {
|
||||
@@ -2874,19 +2931,19 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
JanetEVGenericMessage arguments;
|
||||
memset(&arguments, 0, sizeof(arguments));
|
||||
arguments.tag = (uint32_t) flags;
|
||||
arguments.argi = argc;
|
||||
arguments.argi = (uint32_t) janet_vm.sandbox_flags;
|
||||
arguments.argp = buffer;
|
||||
arguments.fiber = NULL;
|
||||
janet_ev_threaded_call(janet_go_thread_subr, arguments, janet_ev_default_threaded_callback);
|
||||
return janet_wrap_nil();
|
||||
} else {
|
||||
janet_ev_threaded_await(janet_go_thread_subr, (uint32_t) flags, argc, buffer);
|
||||
janet_ev_threaded_await(janet_go_thread_subr, (uint32_t) flags, (uint32_t) janet_vm.sandbox_flags, buffer);
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ev_give_supervisor,
|
||||
"(ev/give-supervisor tag & payload)",
|
||||
"Send a message to the current supervior channel if there is one. The message will be a "
|
||||
"Send a message to the current supervisor channel if there is one. The message will be a "
|
||||
"tuple of all of the arguments combined into a single message, where the first element is tag. "
|
||||
"By convention, tag should be a keyword indicating the type of message. Returns nil.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
499
src/core/ffi.c
499
src/core/ffi.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_FFI
|
||||
@@ -37,6 +38,13 @@
|
||||
#define alloca __builtin_alloca
|
||||
#endif
|
||||
|
||||
/* FFI jit includes */
|
||||
#ifdef JANET_FFI_JIT
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <sys/mman.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#define JANET_FFI_MAX_RECUR 64
|
||||
|
||||
/* Compiler, OS, and arch detection. Used
|
||||
@@ -123,9 +131,10 @@ typedef enum {
|
||||
JANET_SYSV64_INTEGER,
|
||||
JANET_SYSV64_SSE,
|
||||
JANET_SYSV64_SSEUP,
|
||||
JANET_SYSV64_X87,
|
||||
JANET_SYSV64_X87UP,
|
||||
JANET_SYSV64_COMPLEX_X87,
|
||||
JANET_SYSV64_PAIR_INTINT,
|
||||
JANET_SYSV64_PAIR_INTSSE,
|
||||
JANET_SYSV64_PAIR_SSEINT,
|
||||
JANET_SYSV64_PAIR_SSESSE,
|
||||
JANET_SYSV64_NO_CLASS,
|
||||
JANET_SYSV64_MEMORY,
|
||||
JANET_WIN64_REGISTER,
|
||||
@@ -201,6 +210,11 @@ int struct_mark(void *p, size_t s) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
void *function_pointer;
|
||||
size_t size;
|
||||
} JanetFFIJittedFn;
|
||||
|
||||
static const JanetAbstractType janet_struct_type = {
|
||||
"core/ffi-struct",
|
||||
NULL,
|
||||
@@ -208,6 +222,42 @@ static const JanetAbstractType janet_struct_type = {
|
||||
JANET_ATEND_GCMARK
|
||||
};
|
||||
|
||||
static int janet_ffijit_gc(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetFFIJittedFn *fn = p;
|
||||
if (fn->function_pointer == NULL) return 0;
|
||||
#ifdef JANET_FFI_JIT
|
||||
#ifdef JANET_WINDOWS
|
||||
VirtualFree(fn->function_pointer, fn->size, MEM_RELEASE);
|
||||
#else
|
||||
munmap(fn->function_pointer, fn->size);
|
||||
#endif
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetByteView janet_ffijit_getbytes(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetFFIJittedFn *fn = p;
|
||||
JanetByteView bytes;
|
||||
bytes.bytes = fn->function_pointer;
|
||||
bytes.len = (int32_t) fn->size;
|
||||
return bytes;
|
||||
}
|
||||
|
||||
static size_t janet_ffijit_length(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetFFIJittedFn *fn = p;
|
||||
return fn->size;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_type_ffijit = {
|
||||
.name = "ffi/jitfn",
|
||||
.gc = janet_ffijit_gc,
|
||||
.bytes = janet_ffijit_getbytes,
|
||||
.length = janet_ffijit_length
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
Clib clib;
|
||||
int closed;
|
||||
@@ -260,6 +310,7 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) {
|
||||
if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID;
|
||||
if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL;
|
||||
if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR;
|
||||
if (!janet_cstrcmp(name, "pointer")) return JANET_FFI_TYPE_PTR;
|
||||
if (!janet_cstrcmp(name, "string")) return JANET_FFI_TYPE_STRING;
|
||||
if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT;
|
||||
if (!janet_cstrcmp(name, "double")) return JANET_FFI_TYPE_DOUBLE;
|
||||
@@ -355,11 +406,11 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
|
||||
if (all_packed || pack_one) {
|
||||
if (st->size % el_align != 0) is_aligned = 0;
|
||||
st->fields[i].offset = st->size;
|
||||
st->size += el_size;
|
||||
st->size += (uint32_t) el_size;
|
||||
} else {
|
||||
if (el_align > st->align) st->align = el_align;
|
||||
st->fields[i].offset = (((st->size + el_align - 1) / el_align) * el_align);
|
||||
st->size = el_size + st->fields[i].offset;
|
||||
if (el_align > st->align) st->align = (uint32_t) el_align;
|
||||
st->fields[i].offset = (uint32_t)(((st->size + el_align - 1) / el_align) * el_align);
|
||||
st->size = (uint32_t)(el_size + st->fields[i].offset);
|
||||
}
|
||||
i++;
|
||||
}
|
||||
@@ -424,13 +475,15 @@ JANET_CORE_FN(cfun_ffi_align,
|
||||
static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
|
||||
switch (janet_type(argv[n])) {
|
||||
default:
|
||||
janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", argv[n]);
|
||||
janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", n, argv[n]);
|
||||
case JANET_POINTER:
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_ABSTRACT:
|
||||
case JANET_CFUNCTION:
|
||||
return janet_unwrap_pointer(argv[n]);
|
||||
case JANET_ABSTRACT:
|
||||
return (void *) janet_getbytes(argv, n).bytes;
|
||||
case JANET_BUFFER:
|
||||
return janet_unwrap_buffer(argv[n])->data;
|
||||
case JANET_FUNCTION:
|
||||
@@ -443,6 +496,19 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
|
||||
}
|
||||
}
|
||||
|
||||
static void *janet_ffi_get_callable_pointer(const Janet *argv, int32_t n) {
|
||||
switch (janet_type(argv[n])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_POINTER:
|
||||
return janet_unwrap_pointer(argv[n]);
|
||||
case JANET_ABSTRACT:
|
||||
if (!janet_checkabstract(argv[n], &janet_type_ffijit)) break;
|
||||
return ((JanetFFIJittedFn *)janet_unwrap_abstract(argv[n]))->function_pointer;
|
||||
}
|
||||
janet_panicf("bad slot #%d, expected ffi callable pointer type, got %v", n, argv[n]);
|
||||
}
|
||||
|
||||
/* Write a value given by some Janet values and an FFI type as it would appear in memory.
|
||||
* The alignment and space available is assumed to already be sufficient */
|
||||
static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type, int recur) {
|
||||
@@ -477,7 +543,7 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
|
||||
}
|
||||
for (int32_t i = 0; i < els.len; i++) {
|
||||
JanetFFIType tp = st->fields[i].type;
|
||||
janet_ffi_write_one(to + st->fields[i].offset, els.items, i, tp, recur - 1);
|
||||
janet_ffi_write_one((char *) to + st->fields[i].offset, els.items, i, tp, recur - 1);
|
||||
}
|
||||
}
|
||||
break;
|
||||
@@ -485,7 +551,7 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
|
||||
((double *)(to))[0] = janet_getnumber(argv, n);
|
||||
break;
|
||||
case JANET_FFI_TYPE_FLOAT:
|
||||
((float *)(to))[0] = janet_getnumber(argv, n);
|
||||
((float *)(to))[0] = (float) janet_getnumber(argv, n);
|
||||
break;
|
||||
case JANET_FFI_TYPE_PTR:
|
||||
((void **)(to))[0] = janet_ffi_getpointer(argv, n);
|
||||
@@ -509,13 +575,13 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
|
||||
((int64_t *)(to))[0] = janet_getinteger64(argv, n);
|
||||
break;
|
||||
case JANET_FFI_TYPE_UINT8:
|
||||
((uint8_t *)(to))[0] = janet_getuinteger64(argv, n);
|
||||
((uint8_t *)(to))[0] = (uint8_t) janet_getuinteger64(argv, n);
|
||||
break;
|
||||
case JANET_FFI_TYPE_UINT16:
|
||||
((uint16_t *)(to))[0] = janet_getuinteger64(argv, n);
|
||||
((uint16_t *)(to))[0] = (uint16_t) janet_getuinteger64(argv, n);
|
||||
break;
|
||||
case JANET_FFI_TYPE_UINT32:
|
||||
((uint32_t *)(to))[0] = janet_getuinteger64(argv, n);
|
||||
((uint32_t *)(to))[0] = (uint32_t) janet_getuinteger64(argv, n);
|
||||
break;
|
||||
case JANET_FFI_TYPE_UINT64:
|
||||
((uint64_t *)(to))[0] = janet_getuinteger64(argv, n);
|
||||
@@ -601,7 +667,7 @@ static JanetFFIMapping void_mapping(void) {
|
||||
#ifdef JANET_FFI_SYSV64_ENABLED
|
||||
/* AMD64 ABI Draft 0.99.7 – November 17, 2014 – 15:08
|
||||
* See section 3.2.3 Parameter Passing */
|
||||
static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
|
||||
static JanetFFIWordSpec sysv64_classify_ext(JanetFFIType type, size_t shift) {
|
||||
switch (type.prim) {
|
||||
case JANET_FFI_TYPE_PTR:
|
||||
case JANET_FFI_TYPE_STRING:
|
||||
@@ -623,20 +689,63 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
|
||||
if (st->size > 16) return JANET_SYSV64_MEMORY;
|
||||
if (!st->is_aligned) return JANET_SYSV64_MEMORY;
|
||||
JanetFFIWordSpec clazz = JANET_SYSV64_NO_CLASS;
|
||||
for (uint32_t i = 0; i < st->field_count; i++) {
|
||||
JanetFFIWordSpec next_class = sysv64_classify(st->fields[i].type);
|
||||
if (next_class != clazz) {
|
||||
if (clazz == JANET_SYSV64_NO_CLASS) {
|
||||
clazz = next_class;
|
||||
} else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) {
|
||||
clazz = JANET_SYSV64_MEMORY;
|
||||
} else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) {
|
||||
clazz = JANET_SYSV64_INTEGER;
|
||||
} else if (next_class == JANET_SYSV64_X87 || next_class == JANET_SYSV64_X87UP
|
||||
|| next_class == JANET_SYSV64_COMPLEX_X87) {
|
||||
clazz = JANET_SYSV64_MEMORY;
|
||||
} else {
|
||||
clazz = JANET_SYSV64_SSE;
|
||||
if (st->size > 8 && st->size <= 16) {
|
||||
/* map to pair classification */
|
||||
int has_int_lo = 0;
|
||||
int has_int_hi = 0;
|
||||
for (uint32_t i = 0; i < st->field_count; i++) {
|
||||
JanetFFIWordSpec next_class = sysv64_classify_ext(st->fields[i].type, shift + st->fields[i].offset);
|
||||
switch (next_class) {
|
||||
default:
|
||||
break;
|
||||
case JANET_SYSV64_INTEGER:
|
||||
if (shift + st->fields[i].offset + type_size(st->fields[i].type) <= 8) {
|
||||
has_int_lo = 1;
|
||||
} else {
|
||||
has_int_hi = 2;
|
||||
}
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_INTINT:
|
||||
has_int_lo = 1;
|
||||
has_int_hi = 2;
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_INTSSE:
|
||||
has_int_lo = 1;
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_SSEINT:
|
||||
has_int_hi = 2;
|
||||
break;
|
||||
break;
|
||||
}
|
||||
}
|
||||
switch (has_int_hi + has_int_lo) {
|
||||
case 0:
|
||||
clazz = JANET_SYSV64_PAIR_SSESSE;
|
||||
break;
|
||||
case 1:
|
||||
clazz = JANET_SYSV64_PAIR_INTSSE;
|
||||
break;
|
||||
case 2:
|
||||
clazz = JANET_SYSV64_PAIR_SSEINT;
|
||||
break;
|
||||
case 3:
|
||||
clazz = JANET_SYSV64_PAIR_INTINT;
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
/* Normal struct classification */
|
||||
for (uint32_t i = 0; i < st->field_count; i++) {
|
||||
JanetFFIWordSpec next_class = sysv64_classify_ext(st->fields[i].type, shift + st->fields[i].offset);
|
||||
if (next_class != clazz) {
|
||||
if (clazz == JANET_SYSV64_NO_CLASS) {
|
||||
clazz = next_class;
|
||||
} else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) {
|
||||
clazz = JANET_SYSV64_MEMORY;
|
||||
} else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) {
|
||||
clazz = JANET_SYSV64_INTEGER;
|
||||
} else {
|
||||
clazz = JANET_SYSV64_SSE;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -649,6 +758,9 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
|
||||
return JANET_SYSV64_NO_CLASS;
|
||||
}
|
||||
}
|
||||
static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
|
||||
return sysv64_classify_ext(type, 0);
|
||||
}
|
||||
#endif
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_signature,
|
||||
@@ -684,10 +796,10 @@ JANET_CORE_FN(cfun_ffi_signature,
|
||||
#ifdef JANET_FFI_WIN64_ENABLED
|
||||
case JANET_FFI_CC_WIN_64: {
|
||||
size_t ret_size = type_size(ret.type);
|
||||
size_t ref_stack_count = 0;
|
||||
uint32_t ref_stack_count = 0;
|
||||
ret.spec = JANET_WIN64_REGISTER;
|
||||
uint32_t next_register = 0;
|
||||
if (ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) {
|
||||
if (ret_size != 0 && ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) {
|
||||
ret.spec = JANET_WIN64_REGISTER_REF;
|
||||
next_register++;
|
||||
} else if (ret.type.prim == JANET_FFI_TYPE_FLOAT ||
|
||||
@@ -699,20 +811,19 @@ JANET_CORE_FN(cfun_ffi_signature,
|
||||
size_t el_size = type_size(mappings[i].type);
|
||||
int is_register_sized = (el_size == 1 || el_size == 2 || el_size == 4 || el_size == 8);
|
||||
if (next_register < 4) {
|
||||
mappings[i].offset = next_register++;
|
||||
mappings[i].offset = next_register;
|
||||
if (is_register_sized) {
|
||||
mappings[i].spec = JANET_WIN64_REGISTER;
|
||||
|
||||
/* Select variant based on position of floating point arguments */
|
||||
if (mappings[i].type.prim == JANET_FFI_TYPE_FLOAT ||
|
||||
mappings[i].type.prim == JANET_FFI_TYPE_DOUBLE) {
|
||||
variant += 1 << next_register;
|
||||
variant += 1 << (3 - next_register);
|
||||
}
|
||||
} else {
|
||||
mappings[i].spec = JANET_WIN64_REGISTER_REF;
|
||||
mappings[i].offset2 = ref_stack_count;
|
||||
ref_stack_count += (el_size + 15) / 16;
|
||||
ref_stack_count += (uint32_t)((el_size + 15) / 16);
|
||||
}
|
||||
next_register++;
|
||||
} else {
|
||||
if (is_register_sized) {
|
||||
mappings[i].spec = JANET_WIN64_STACK;
|
||||
@@ -723,30 +834,24 @@ JANET_CORE_FN(cfun_ffi_signature,
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count++;
|
||||
mappings[i].offset2 = ref_stack_count;
|
||||
ref_stack_count += (el_size + 15) / 16;
|
||||
ref_stack_count += (uint32_t)((el_size + 15) / 16);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Take into account reference arguments and align to 16 bytes just in case */
|
||||
/* Add reference items */
|
||||
stack_count += 2 * ref_stack_count;
|
||||
if (stack_count & 1) {
|
||||
if (stack_count & 0x1) {
|
||||
stack_count++;
|
||||
}
|
||||
|
||||
/* Invert stack
|
||||
* Offsets are in units of 8-bytes */
|
||||
for (uint32_t i = 0; i < arg_count; i++) {
|
||||
uint32_t old_offset = mappings[i].offset;
|
||||
if (mappings[i].spec == JANET_WIN64_STACK) {
|
||||
mappings[i].offset = stack_count - 1 - old_offset;
|
||||
} else if (mappings[i].spec == JANET_WIN64_STACK_REF) {
|
||||
mappings[i].offset = stack_count - 1 - old_offset;
|
||||
}
|
||||
if (mappings[i].spec == JANET_WIN64_STACK_REF || mappings[i].spec == JANET_WIN64_REGISTER_REF) {
|
||||
/* Align size to 16 bytes */
|
||||
size_t size = (type_size(mappings[i].type) + 15) & ~0xFUL;
|
||||
mappings[i].offset2 = stack_count - mappings[i].offset2 - (size / 8);
|
||||
mappings[i].offset2 = (uint32_t)(stack_count - mappings[i].offset2 - (size / 8));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -759,6 +864,8 @@ JANET_CORE_FN(cfun_ffi_signature,
|
||||
JanetFFIWordSpec ret_spec = sysv64_classify(ret.type);
|
||||
ret.spec = ret_spec;
|
||||
if (ret_spec == JANET_SYSV64_SSE) variant = 1;
|
||||
if (ret_spec == JANET_SYSV64_PAIR_INTSSE) variant = 2;
|
||||
if (ret_spec == JANET_SYSV64_PAIR_SSEINT) variant = 3;
|
||||
/* Spill register overflow to memory */
|
||||
uint32_t next_register = 0;
|
||||
uint32_t next_fp_register = 0;
|
||||
@@ -787,8 +894,8 @@ JANET_CORE_FN(cfun_ffi_signature,
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case JANET_SYSV64_SSE: {
|
||||
if (next_fp_register < max_fp_regs) {
|
||||
mappings[i].offset = next_fp_register++;
|
||||
@@ -797,21 +904,57 @@ JANET_CORE_FN(cfun_ffi_signature,
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case JANET_SYSV64_MEMORY: {
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Invert stack */
|
||||
for (uint32_t i = 0; i < arg_count; i++) {
|
||||
if (mappings[i].spec == JANET_SYSV64_MEMORY) {
|
||||
uint32_t old_offset = mappings[i].offset;
|
||||
size_t el_size = type_size(mappings[i].type);
|
||||
mappings[i].offset = stack_count - ((el_size + 7) / 8) - old_offset;
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_INTINT: {
|
||||
if (next_register + 1 < max_regs) {
|
||||
mappings[i].offset = next_register++;
|
||||
mappings[i].offset2 = next_register++;
|
||||
} else {
|
||||
mappings[i].spec = JANET_SYSV64_MEMORY;
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
}
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_INTSSE: {
|
||||
if (next_register < max_regs && next_fp_register < max_fp_regs) {
|
||||
mappings[i].offset = next_register++;
|
||||
mappings[i].offset2 = next_fp_register++;
|
||||
} else {
|
||||
mappings[i].spec = JANET_SYSV64_MEMORY;
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
}
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_SSEINT: {
|
||||
if (next_register < max_regs && next_fp_register < max_fp_regs) {
|
||||
mappings[i].offset = next_fp_register++;
|
||||
mappings[i].offset2 = next_register++;
|
||||
} else {
|
||||
mappings[i].spec = JANET_SYSV64_MEMORY;
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
}
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_SSESSE: {
|
||||
if (next_fp_register < max_fp_regs) {
|
||||
mappings[i].offset = next_fp_register++;
|
||||
mappings[i].offset2 = next_fp_register++;
|
||||
} else {
|
||||
mappings[i].spec = JANET_SYSV64_MEMORY;
|
||||
mappings[i].offset = stack_count;
|
||||
stack_count += el_size;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -847,23 +990,38 @@ typedef struct {
|
||||
double x;
|
||||
double y;
|
||||
} sysv64_sse_return;
|
||||
typedef struct {
|
||||
uint64_t x;
|
||||
double y;
|
||||
} sysv64_intsse_return;
|
||||
typedef struct {
|
||||
double y;
|
||||
uint64_t x;
|
||||
} sysv64_sseint_return;
|
||||
typedef sysv64_int_return janet_sysv64_variant_1(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||
typedef sysv64_sse_return janet_sysv64_variant_2(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||
typedef sysv64_intsse_return janet_sysv64_variant_3(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||
typedef sysv64_sseint_return janet_sysv64_variant_4(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||
|
||||
static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
|
||||
sysv64_int_return int_return;
|
||||
sysv64_sse_return sse_return;
|
||||
union {
|
||||
sysv64_int_return int_return;
|
||||
sysv64_sse_return sse_return;
|
||||
sysv64_sseint_return sseint_return;
|
||||
sysv64_intsse_return intsse_return;
|
||||
} retu;
|
||||
uint64_t pair[2];
|
||||
uint64_t regs[6];
|
||||
double fp_regs[8];
|
||||
JanetFFIWordSpec ret_spec = signature->ret.spec;
|
||||
void *ret_mem = &int_return;
|
||||
void *ret_mem = &retu.int_return;
|
||||
if (ret_spec == JANET_SYSV64_MEMORY) {
|
||||
ret_mem = alloca(type_size(signature->ret.type));
|
||||
regs[0] = (uint64_t) ret_mem;
|
||||
} else if (ret_spec == JANET_SYSV64_SSE) {
|
||||
ret_mem = &sse_return;
|
||||
}
|
||||
uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count);
|
||||
for (uint32_t i = 0; i < signature->arg_count; i++) {
|
||||
@@ -882,21 +1040,55 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point
|
||||
case JANET_SYSV64_MEMORY:
|
||||
to = stack + arg.offset;
|
||||
break;
|
||||
case JANET_SYSV64_PAIR_INTINT:
|
||||
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
regs[arg.offset] = pair[0];
|
||||
regs[arg.offset2] = pair[1];
|
||||
continue;
|
||||
case JANET_SYSV64_PAIR_INTSSE:
|
||||
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
regs[arg.offset] = pair[0];
|
||||
((uint64_t *) fp_regs)[arg.offset2] = pair[1];
|
||||
continue;
|
||||
case JANET_SYSV64_PAIR_SSEINT:
|
||||
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
((uint64_t *) fp_regs)[arg.offset] = pair[0];
|
||||
regs[arg.offset2] = pair[1];
|
||||
continue;
|
||||
case JANET_SYSV64_PAIR_SSESSE:
|
||||
janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
((uint64_t *) fp_regs)[arg.offset] = pair[0];
|
||||
((uint64_t *) fp_regs)[arg.offset2] = pair[1];
|
||||
continue;
|
||||
}
|
||||
janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
}
|
||||
|
||||
if (signature->variant) {
|
||||
sse_return = ((janet_sysv64_variant_2 *)(function_pointer))(
|
||||
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
|
||||
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
|
||||
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
|
||||
} else {
|
||||
int_return = ((janet_sysv64_variant_1 *)(function_pointer))(
|
||||
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
|
||||
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
|
||||
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
|
||||
|
||||
switch (signature->variant) {
|
||||
case 0:
|
||||
retu.int_return = ((janet_sysv64_variant_1 *)(function_pointer))(
|
||||
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
|
||||
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
|
||||
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
|
||||
break;
|
||||
case 1:
|
||||
retu.sse_return = ((janet_sysv64_variant_2 *)(function_pointer))(
|
||||
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
|
||||
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
|
||||
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
|
||||
break;
|
||||
case 2:
|
||||
retu.intsse_return = ((janet_sysv64_variant_3 *)(function_pointer))(
|
||||
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
|
||||
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
|
||||
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
|
||||
break;
|
||||
case 3:
|
||||
retu.sseint_return = ((janet_sysv64_variant_4 *)(function_pointer))(
|
||||
regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
|
||||
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
|
||||
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
|
||||
break;
|
||||
}
|
||||
|
||||
return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
|
||||
@@ -961,33 +1153,44 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
|
||||
} ret_reg;
|
||||
JanetFFIWordSpec ret_spec = signature->ret.spec;
|
||||
void *ret_mem = &ret_reg.integer;
|
||||
if (ret_spec == JANET_WIN64_STACK) {
|
||||
if (ret_spec == JANET_WIN64_REGISTER_REF) {
|
||||
ret_mem = alloca(type_size(signature->ret.type));
|
||||
regs[0].integer = (uint64_t) ret_mem;
|
||||
}
|
||||
uint64_t *stack = alloca(signature->stack_count * 8);
|
||||
size_t stack_size = signature->stack_count * 8;
|
||||
size_t stack_shift = 2;
|
||||
uint64_t *stack = alloca(stack_size);
|
||||
for (uint32_t i = 0; i < signature->arg_count; i++) {
|
||||
int32_t n = i + 2;
|
||||
JanetFFIMapping arg = signature->args[i];
|
||||
if (arg.spec == JANET_WIN64_STACK) {
|
||||
janet_ffi_write_one(stack + arg.offset, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
} else if (arg.spec == JANET_WIN64_STACK_REF) {
|
||||
uint8_t *ptr = (uint8_t *)(stack + args.offset2);
|
||||
uint8_t *ptr = (uint8_t *)(stack + arg.offset2);
|
||||
janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
stack[args.offset] = (uint64_t) ptr;
|
||||
stack[arg.offset] = (uint64_t)(ptr - stack_shift * sizeof(uint64_t));
|
||||
} else if (arg.spec == JANET_WIN64_REGISTER_REF) {
|
||||
uint8_t *ptr = (uint8_t *)(stack + args.offset2);
|
||||
uint8_t *ptr = (uint8_t *)(stack + arg.offset2);
|
||||
janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
regs[args.offset].integer = (uint64_t) ptr;
|
||||
regs[arg.offset].integer = (uint64_t)(ptr - stack_shift * sizeof(uint64_t));
|
||||
} else {
|
||||
janet_ffi_write_one((uint8_t *) ®s[arg.offset].integer, argv, n, arg.type, JANET_FFI_MAX_RECUR);
|
||||
}
|
||||
}
|
||||
|
||||
/* the seasoned programmer who cut their teeth on assembly is probably quietly shaking their head by now... */
|
||||
/* hack to get proper stack placement and avoid clobbering from logic above - shift stack down, otherwise we have issues.
|
||||
* Technically, this writes into 16 bytes of unallocated stack memory */
|
||||
#ifdef JANET_MINGW
|
||||
#pragma GCC diagnostic ignored "-Wstringop-overflow"
|
||||
#endif
|
||||
if (stack_size) memmove(stack - stack_shift, stack, stack_size);
|
||||
#ifdef JANET_MINGW
|
||||
#pragma GCC diagnostic pop
|
||||
#endif
|
||||
|
||||
switch (signature->variant) {
|
||||
default:
|
||||
janet_panic("unknown variant");
|
||||
janet_panicf("unknown variant %d", signature->variant);
|
||||
case 0:
|
||||
ret_reg.integer = ((win64_variant_i_iiii *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].integer, regs[3].integer);
|
||||
break;
|
||||
@@ -1091,12 +1294,71 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
|
||||
|
||||
#endif
|
||||
|
||||
/* Allocate executable memory chunks in sizes of a page. Ideally we would keep
|
||||
* an allocator around so that multiple JIT allocations would point to the same
|
||||
* region but it isn't really worth it. */
|
||||
#define FFI_PAGE_MASK 0xFFF
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_jitfn,
|
||||
"(ffi/jitfn bytes)",
|
||||
"Create an abstract type that can be used as the pointer argument to `ffi/call`. The content "
|
||||
"of `bytes` is architecture specific machine code that will be copied into executable memory.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
|
||||
/* Quick hack to align to page boundary, we should query OS. FIXME */
|
||||
size_t alloc_size = ((size_t) bytes.len + FFI_PAGE_MASK) & ~FFI_PAGE_MASK;
|
||||
|
||||
#ifdef JANET_FFI_JIT
|
||||
#ifdef JANET_EV
|
||||
JanetFFIJittedFn *fn = janet_abstract_threaded(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
|
||||
#else
|
||||
JanetFFIJittedFn *fn = janet_abstract(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
|
||||
#endif
|
||||
fn->function_pointer = NULL;
|
||||
fn->size = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
void *ptr = VirtualAlloc(NULL, alloc_size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
|
||||
#elif defined(MAP_ANONYMOUS)
|
||||
void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
|
||||
#elif defined(MAP_ANON)
|
||||
/* macos doesn't have MAP_ANONYMOUS */
|
||||
void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0);
|
||||
#else
|
||||
/* -std=c99 gets in the way */
|
||||
/* #define MAP_ANONYMOUS 0x20 should work, though. */
|
||||
void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE, -1, 0);
|
||||
#endif
|
||||
if (!ptr) {
|
||||
janet_panic("failed to memory map writable memory");
|
||||
}
|
||||
memcpy(ptr, bytes.bytes, bytes.len);
|
||||
#ifdef JANET_WINDOWS
|
||||
DWORD old = 0;
|
||||
if (!VirtualProtect(ptr, alloc_size, PAGE_EXECUTE_READ, &old)) {
|
||||
janet_panic("failed to make mapped memory executable");
|
||||
}
|
||||
#else
|
||||
if (mprotect(ptr, alloc_size, PROT_READ | PROT_EXEC) == -1) {
|
||||
janet_panic("failed to make mapped memory executable");
|
||||
}
|
||||
#endif
|
||||
fn->size = alloc_size;
|
||||
fn->function_pointer = ptr;
|
||||
return janet_wrap_abstract(fn);
|
||||
#else
|
||||
janet_panic("ffi/jitfn not available on this platform");
|
||||
#endif
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_call,
|
||||
"(ffi/call pointer signature & args)",
|
||||
"Call a raw pointer as a function pointer. The function signature specifies "
|
||||
"how Janet values in `args` are converted to native machine types.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, -1);
|
||||
void *function_pointer = janet_getpointer(argv, 0);
|
||||
void *function_pointer = janet_ffi_get_callable_pointer(argv, 0);
|
||||
JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type);
|
||||
janet_fixarity(argc - 2, signature->arg_count);
|
||||
switch (signature->cc) {
|
||||
@@ -1115,18 +1377,25 @@ JANET_CORE_FN(cfun_ffi_call,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_buffer_write,
|
||||
"(ffi/write ffi-type data &opt buffer)",
|
||||
"Append a native tyep to a buffer such as it would appear in memory. This can be used "
|
||||
"(ffi/write ffi-type data &opt buffer index)",
|
||||
"Append a native type to a buffer such as it would appear in memory. This can be used "
|
||||
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
|
||||
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
size_t el_size = type_size(type);
|
||||
uint32_t el_size = (uint32_t) type_size(type);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size);
|
||||
int32_t index = janet_optnat(argv, argc, 3, 0);
|
||||
int32_t old_count = buffer->count;
|
||||
if (index > old_count) janet_panic("index out of bounds");
|
||||
buffer->count = index;
|
||||
janet_buffer_extra(buffer, el_size);
|
||||
memset(buffer->data, 0, el_size);
|
||||
janet_ffi_write_one(buffer->data, argv, 1, type, JANET_FFI_MAX_RECUR);
|
||||
buffer->count += el_size;
|
||||
buffer->count = old_count;
|
||||
memset(buffer->data + index, 0, el_size);
|
||||
janet_ffi_write_one(buffer->data + index, argv, 1, type, JANET_FFI_MAX_RECUR);
|
||||
index += el_size;
|
||||
if (buffer->count < index) buffer->count = index;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
@@ -1135,6 +1404,7 @@ JANET_CORE_FN(cfun_ffi_buffer_read,
|
||||
"Parse a native struct out of a buffer and convert it to normal Janet data structures. "
|
||||
"This function is the inverse of `ffi/write`. `bytes` can also be a raw pointer, although "
|
||||
"this is unsafe.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
size_t offset = (size_t) janet_optnat(argv, argc, 2, 0);
|
||||
@@ -1181,11 +1451,10 @@ JANET_CORE_FN(janet_core_raw_native,
|
||||
" or run any code from it. This is different than `native`, which will "
|
||||
"run initialization code to get a module table. If `path` is nil, opens the current running binary. "
|
||||
"Returns a `core/native`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *path = janet_optcstring(argv, argc, 0, NULL);
|
||||
char *processed_name = (NULL == path) ? NULL : get_processed_name(path);
|
||||
Clib lib = load_clib(processed_name);
|
||||
if (NULL != path && path != processed_name) janet_free(processed_name);
|
||||
Clib lib = load_clib(path);
|
||||
if (!lib) janet_panic(error_clib());
|
||||
JanetAbstractNative *anative = janet_abstract(&janet_native_type, sizeof(JanetAbstractNative));
|
||||
anative->clib = lib;
|
||||
@@ -1198,6 +1467,7 @@ JANET_CORE_FN(janet_core_native_lookup,
|
||||
"(ffi/lookup native symbol-name)",
|
||||
"Lookup a symbol from a native object. All symbol lookups will return a raw pointer "
|
||||
"if the symbol is found, else nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 2);
|
||||
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
|
||||
const char *sym = janet_getcstring(argv, 1);
|
||||
@@ -1211,6 +1481,7 @@ JANET_CORE_FN(janet_core_native_close,
|
||||
"(ffi/close native)",
|
||||
"Free a native object. Dereferencing pointers to symbols in the object will have undefined "
|
||||
"behavior after freeing.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
|
||||
if (anative->closed) janet_panic("native object already closed");
|
||||
@@ -1220,6 +1491,44 @@ JANET_CORE_FN(janet_core_native_close,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_malloc,
|
||||
"(ffi/malloc size)",
|
||||
"Allocates memory directly using the janet memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
size_t size = janet_getsize(argv, 0);
|
||||
if (size == 0) return janet_wrap_nil();
|
||||
return janet_wrap_pointer(janet_malloc(size));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_free,
|
||||
"(ffi/free pointer)",
|
||||
"Free memory allocated with `ffi/malloc`. Returns nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checktype(argv[0], JANET_NIL)) return janet_wrap_nil();
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
janet_free(pointer);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_pointer_buffer,
|
||||
"(ffi/pointer-buffer pointer capacity &opt count offset)",
|
||||
"Create a buffer from a pointer. The underlying memory of the buffer will not be "
|
||||
"reallocated or freed by the garbage collector, allowing unmanaged, mutable memory "
|
||||
"to be manipulated with buffer functions. Attempts to resize or extend the buffer "
|
||||
"beyond its initial capacity will raise an error. As with many FFI functions, this is memory "
|
||||
"unsafe and can potentially allow out of bounds memory access. Returns a new buffer.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, 4);
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
int32_t capacity = janet_getnat(argv, 1);
|
||||
int32_t count = janet_optnat(argv, argc, 2, 0);
|
||||
int64_t offset = janet_optinteger64(argv, argc, 3, 0);
|
||||
uint8_t *offset_pointer = ((uint8_t *) pointer) + offset;
|
||||
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
|
||||
}
|
||||
|
||||
void janet_lib_ffi(JanetTable *env) {
|
||||
JanetRegExt ffi_cfuns[] = {
|
||||
JANET_CORE_REG("ffi/native", janet_core_raw_native),
|
||||
@@ -1233,6 +1542,10 @@ void janet_lib_ffi(JanetTable *env) {
|
||||
JANET_CORE_REG("ffi/size", cfun_ffi_size),
|
||||
JANET_CORE_REG("ffi/align", cfun_ffi_align),
|
||||
JANET_CORE_REG("ffi/trampoline", cfun_ffi_get_callback_trampoline),
|
||||
JANET_CORE_REG("ffi/jitfn", cfun_ffi_jitfn),
|
||||
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
|
||||
JANET_CORE_REG("ffi/free", cfun_ffi_free),
|
||||
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, ffi_cfuns);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -209,6 +209,12 @@ static void janet_mark_funcdef(JanetFuncDef *def) {
|
||||
janet_mark_string(def->source);
|
||||
if (def->name)
|
||||
janet_mark_string(def->name);
|
||||
if (def->symbolmap) {
|
||||
for (int i = 0; i < def->symbolmap_length; i++) {
|
||||
janet_mark_string(def->symbolmap[i].symbol);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static void janet_mark_function(JanetFunction *func) {
|
||||
@@ -314,6 +320,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
janet_free(def->bytecode);
|
||||
janet_free(def->sourcemap);
|
||||
janet_free(def->closure_bitset);
|
||||
janet_free(def->symbolmap);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose & contributors
|
||||
* Copyright (c) 2023 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -407,13 +407,26 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/*
|
||||
* In C, signed arithmetic overflow is undefined behvior
|
||||
* but unsigned arithmetic overflow is twos complement
|
||||
*
|
||||
* Reference:
|
||||
* https://en.cppreference.com/w/cpp/language/ub
|
||||
* http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
|
||||
*
|
||||
* This means OPMETHOD & OPMETHODINVERT must always use
|
||||
* unsigned arithmetic internally, regardless of the true type.
|
||||
* This will not affect the end result (property of twos complement).
|
||||
*/
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
/* This avoids undefined behavior. See above for why. */ \
|
||||
*box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
@@ -422,7 +435,8 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
/* This avoids undefined behavior. See above for why. */ \
|
||||
*box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
@@ -518,7 +532,6 @@ OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
@@ -541,7 +554,6 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -567,7 +579,6 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -69,12 +69,15 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
break;
|
||||
case 'w':
|
||||
flags |= JANET_FILE_WRITE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'a':
|
||||
flags |= JANET_FILE_APPEND;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS);
|
||||
break;
|
||||
case 'r':
|
||||
flags |= JANET_FILE_READ;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
}
|
||||
for (i = 1; i < len; i++) {
|
||||
@@ -84,6 +87,7 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
break;
|
||||
case '+':
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
flags |= JANET_FILE_UPDATE;
|
||||
break;
|
||||
case 'b':
|
||||
@@ -116,6 +120,7 @@ JANET_CORE_FN(cfun_io_temp,
|
||||
"(file/temp)",
|
||||
"Open an anonymous temporary file that is removed on close. "
|
||||
"Raises an error on failure.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_TEMP);
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
@@ -148,6 +153,7 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
@@ -243,6 +249,13 @@ JANET_CORE_FN(cfun_io_fwrite,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static void io_assert_writeable(JanetFile *iof) {
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
}
|
||||
|
||||
/* Flush the bytes in the file */
|
||||
JANET_CORE_FN(cfun_io_fflush,
|
||||
"(file/flush f)",
|
||||
@@ -250,10 +263,7 @@ JANET_CORE_FN(cfun_io_fflush,
|
||||
"buffered for efficiency reasons. Returns the file handle.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
io_assert_writeable(iof);
|
||||
if (fflush(iof->file))
|
||||
janet_panic("could not flush file");
|
||||
return argv[0];
|
||||
@@ -269,6 +279,7 @@ int janet_file_close(JanetFile *file) {
|
||||
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
ret = fclose(file->file);
|
||||
file->flags |= JANET_FILE_CLOSED;
|
||||
file->file = NULL; /* NULL derefence is easier to debug then other problems */
|
||||
return ret;
|
||||
}
|
||||
return 0;
|
||||
@@ -337,11 +348,24 @@ JANET_CORE_FN(cfun_io_fseek,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_ftell,
|
||||
"(file/tell f)",
|
||||
"Get the current value of the file position for file `f`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long pos = ftell(iof->file);
|
||||
if (pos == -1) janet_panic("error getting position in file");
|
||||
return janet_wrap_number((double)pos);
|
||||
}
|
||||
|
||||
static JanetMethod io_file_methods[] = {
|
||||
{"close", cfun_io_fclose},
|
||||
{"flush", cfun_io_fflush},
|
||||
{"read", cfun_io_fread},
|
||||
{"seek", cfun_io_fseek},
|
||||
{"tell", cfun_io_ftell},
|
||||
{"write", cfun_io_fwrite},
|
||||
{NULL, NULL}
|
||||
};
|
||||
@@ -449,6 +473,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
JanetFile *iofile = abstract;
|
||||
io_assert_writeable(iofile);
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
@@ -545,6 +570,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_FUNCTION: {
|
||||
/* Special case function */
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
JanetBuffer *buf = janet_buffer(0);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
||||
janet_call(fun, 1, args);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
@@ -554,6 +589,10 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
JanetFile *iofile = abstract;
|
||||
if (iofile->flags & JANET_FILE_CLOSED) {
|
||||
janet_panic("cannot print to closed file");
|
||||
}
|
||||
io_assert_writeable(iofile);
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
@@ -678,12 +717,23 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
break;
|
||||
JanetFile *iofile = abstract;
|
||||
io_assert_writeable(iofile);
|
||||
f = iofile->file;
|
||||
}
|
||||
fwrite(buffer.data, buffer.count, 1, f);
|
||||
janet_buffer_deinit(&buffer);
|
||||
break;
|
||||
}
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
JanetBuffer *buf = janet_buffer(len);
|
||||
janet_formatbv(buf, format, args);
|
||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
||||
janet_call(fun, 1, args);
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
@@ -698,17 +748,17 @@ JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
|
||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
JanetFile *janet_makejfile(FILE *f, int flags) {
|
||||
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
Janet janet_makefile(FILE *f, int32_t flags) {
|
||||
return janet_wrap_abstract(makef(f, flags));
|
||||
}
|
||||
|
||||
@@ -716,7 +766,7 @@ JanetAbstract janet_checkfile(Janet j) {
|
||||
return janet_checkabstract(j, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
FILE *janet_unwrapfile(Janet j, int32_t *flags) {
|
||||
JanetFile *iof = janet_unwrap_abstract(j);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
@@ -746,6 +796,7 @@ void janet_lib_io(JanetTable *env) {
|
||||
JANET_CORE_REG("file/write", cfun_io_fwrite),
|
||||
JANET_CORE_REG("file/flush", cfun_io_fflush),
|
||||
JANET_CORE_REG("file/seek", cfun_io_fseek),
|
||||
JANET_CORE_REG("file/tell", cfun_io_ftell),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, io_cfuns);
|
||||
|
||||
117
src/core/marsh.c
117
src/core/marsh.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,6 +37,7 @@ typedef struct {
|
||||
JanetFuncEnv **seen_envs;
|
||||
JanetFuncDef **seen_defs;
|
||||
int32_t nextid;
|
||||
int maybe_cycles;
|
||||
} MarshalState;
|
||||
|
||||
/* Lead bytes in marshaling protocol */
|
||||
@@ -66,7 +67,8 @@ enum {
|
||||
LB_UNSAFE_POINTER, /* 222 */
|
||||
LB_STRUCT_PROTO, /* 223 */
|
||||
#ifdef JANET_EV
|
||||
LB_THREADED_ABSTRACT/* 224 */
|
||||
LB_THREADED_ABSTRACT, /* 224 */
|
||||
LB_POINTER_BUFFER, /* 224 */
|
||||
#endif
|
||||
} LeadBytes;
|
||||
|
||||
@@ -152,6 +154,10 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
static void pushpointer(MarshalState *st, void *ptr) {
|
||||
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
|
||||
}
|
||||
|
||||
/* Marshal a size_t onto the buffer */
|
||||
static void push64(MarshalState *st, uint64_t x) {
|
||||
if (x <= 0xF0) {
|
||||
@@ -251,6 +257,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
pushint(st, def->environments_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
pushint(st, def->defs_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
|
||||
pushint(st, def->symbolmap_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
|
||||
marshal_one(st, janet_wrap_string(def->name), flags);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
|
||||
@@ -260,6 +268,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
for (int32_t i = 0; i < def->constants_length; i++)
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
|
||||
/* Marshal symbol map, if needed */
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].death_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].slot_index);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
|
||||
}
|
||||
|
||||
/* marshal the bytecode */
|
||||
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
|
||||
|
||||
@@ -269,7 +285,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
/* marshal the sub funcdefs if needed */
|
||||
for (int32_t i = 0; i < def->defs_length; i++)
|
||||
marshal_one_def(st, def->defs[i], flags);
|
||||
marshal_one_def(st, def->defs[i], flags + 1);
|
||||
|
||||
/* marshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
@@ -364,13 +380,15 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
||||
|
||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
if (st->maybe_cycles) {
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
}
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
|
||||
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
@@ -428,11 +446,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
|
||||
/* Check reference and registry value */
|
||||
{
|
||||
Janet check = janet_table_get(&st->seen, x);
|
||||
if (janet_checkint(check)) {
|
||||
pushbyte(st, LB_REFERENCE);
|
||||
pushint(st, janet_unwrap_integer(check));
|
||||
return;
|
||||
Janet check;
|
||||
if (st->maybe_cycles) {
|
||||
check = janet_table_get(&st->seen, x);
|
||||
if (janet_checkint(check)) {
|
||||
pushbyte(st, LB_REFERENCE);
|
||||
pushint(st, janet_unwrap_integer(check));
|
||||
return;
|
||||
}
|
||||
}
|
||||
if (st->rreg) {
|
||||
check = janet_table_get(st->rreg, x);
|
||||
@@ -495,6 +516,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(x);
|
||||
/* Record reference */
|
||||
MARK_SEEN();
|
||||
#ifdef JANET_EV
|
||||
if ((flags & JANET_MARSHAL_UNSAFE) &&
|
||||
(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||
pushbyte(st, LB_POINTER_BUFFER);
|
||||
pushint(st, buffer->count);
|
||||
pushint(st, buffer->capacity);
|
||||
pushpointer(st, buffer->data);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
pushbyte(st, LB_BUFFER);
|
||||
pushint(st, buffer->count);
|
||||
pushbytes(st, buffer->data, buffer->count);
|
||||
@@ -590,8 +621,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_POINTER);
|
||||
void *ptr = janet_unwrap_pointer(x);
|
||||
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
|
||||
pushpointer(st, janet_unwrap_pointer(x));
|
||||
return;
|
||||
}
|
||||
no_registry:
|
||||
@@ -613,6 +643,7 @@ void janet_marshal(
|
||||
st.seen_defs = NULL;
|
||||
st.seen_envs = NULL;
|
||||
st.rreg = rreg;
|
||||
st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
|
||||
janet_table_init(&st.seen, 0);
|
||||
marshal_one(&st, x, flags);
|
||||
janet_table_deinit(&st.seen);
|
||||
@@ -817,6 +848,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->sourcemap = NULL;
|
||||
def->symbolmap = NULL;
|
||||
def->symbolmap_length = 0;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -824,6 +857,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
int32_t constants_length = 0;
|
||||
int32_t environments_length = 0;
|
||||
int32_t defs_length = 0;
|
||||
int32_t symbolmap_length = 0;
|
||||
|
||||
/* Read flags and other fixed values */
|
||||
def->flags = readint(st, &data);
|
||||
@@ -839,6 +873,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
environments_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
defs_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
|
||||
symbolmap_length = readnat(st, &data);
|
||||
|
||||
/* Check name and source (optional) */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
@@ -867,6 +903,26 @@ static const uint8_t *unmarshal_one_def(
|
||||
}
|
||||
def->constants_length = constants_length;
|
||||
|
||||
/* Unmarshal symbol map, if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP) {
|
||||
size_t size = sizeof(JanetSymbolMap) * symbolmap_length;
|
||||
def->symbolmap = janet_malloc(size);
|
||||
if (def->symbolmap == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < symbolmap_length; i++) {
|
||||
def->symbolmap[i].birth_pc = (uint32_t) readint(st, &data);
|
||||
def->symbolmap[i].death_pc = (uint32_t) readint(st, &data);
|
||||
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
|
||||
Janet value;
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
if (!janet_checktype(value, JANET_SYMBOL))
|
||||
janet_panic("expected symbol in symbol map");
|
||||
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
|
||||
}
|
||||
def->symbolmap_length = (uint32_t) symbolmap_length;
|
||||
}
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
||||
if (!def->bytecode) {
|
||||
@@ -1373,6 +1429,29 @@ static const uint8_t *unmarshal_one(
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
case LB_POINTER_BUFFER: {
|
||||
data++;
|
||||
int32_t count = readnat(st, &data);
|
||||
int32_t capacity = readnat(st, &data);
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
union {
|
||||
void *ptr;
|
||||
uint8_t bytes[sizeof(void *)];
|
||||
} u;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal raw pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
memcpy(u.bytes, data, sizeof(void *));
|
||||
data += sizeof(void *);
|
||||
JanetBuffer *buffer = janet_pointer_buffer_unsafe(u.ptr, capacity, count);
|
||||
*out = janet_wrap_buffer(buffer);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
#endif
|
||||
case LB_UNSAFE_CFUNCTION: {
|
||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||
data++;
|
||||
@@ -1471,16 +1550,17 @@ JANET_CORE_FN(cfun_env_lookup,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_marshal,
|
||||
"(marshal x &opt reverse-lookup buffer)",
|
||||
"(marshal x &opt reverse-lookup buffer no-cycles)",
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can then later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward "
|
||||
"lookup table can be used to recover the original value when "
|
||||
"unmarshalling.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg = NULL;
|
||||
uint32_t flags = 0;
|
||||
if (argc > 1) {
|
||||
rreg = janet_gettable(argv, 1);
|
||||
}
|
||||
@@ -1489,7 +1569,10 @@ JANET_CORE_FN(cfun_marshal,
|
||||
} else {
|
||||
buffer = janet_buffer(10);
|
||||
}
|
||||
janet_marshal(buffer, argv[0], rreg, 0);
|
||||
if (argc > 3 && janet_truthy(argv[3])) {
|
||||
flags |= JANET_MARSHAL_NO_CYCLES;
|
||||
}
|
||||
janet_marshal(buffer, argv[0], rreg, flags);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -150,8 +150,8 @@ JANET_CORE_FN(cfun_rng_uniform,
|
||||
|
||||
JANET_CORE_FN(cfun_rng_int,
|
||||
"(math/rng-int rng &opt max)",
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1."
|
||||
"Extract a random integer in the range [0, max) for max > 0 from the RNG. "
|
||||
"If max is 0, return 0. If no max is given, the default is 2^31 - 1."
|
||||
) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
@@ -254,13 +254,15 @@ JANET_CORE_FN(janet_srand,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
|
||||
#define JANET_DEFINE_NAMED_MATHOP(c_name, janet_name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##c_name, "(math/" #janet_name " x)", doc) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc) JANET_DEFINE_NAMED_MATHOP(name, name, fop, doc)
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
|
||||
JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
|
||||
@@ -269,7 +271,7 @@ JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
|
||||
JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
|
||||
JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hypberbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hyperbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
|
||||
JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
|
||||
JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
|
||||
@@ -282,12 +284,12 @@ JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
|
||||
JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
|
||||
JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(abs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
|
||||
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
|
||||
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
|
||||
JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
|
||||
JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_NAMED_MATHOP(lgamma, "log-gamma", lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
|
||||
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
|
||||
@@ -303,7 +305,7 @@ JANET_CORE_FN(janet_##name, signature, doc) {\
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
|
||||
JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point vaue after x in the direction of y.")
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
|
||||
|
||||
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -368,7 +370,7 @@ void janet_lib_math(JanetTable *env) {
|
||||
JANET_CORE_REG("math/floor", janet_floor),
|
||||
JANET_CORE_REG("math/ceil", janet_ceil),
|
||||
JANET_CORE_REG("math/pow", janet_pow),
|
||||
JANET_CORE_REG("math/abs", janet_fabs),
|
||||
JANET_CORE_REG("math/abs", janet_abs),
|
||||
JANET_CORE_REG("math/sinh", janet_sinh),
|
||||
JANET_CORE_REG("math/cosh", janet_cosh),
|
||||
JANET_CORE_REG("math/tanh", janet_tanh),
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose and contributors.
|
||||
* Copyright (c) 2023 Calvin Rose and contributors.
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -34,9 +34,11 @@
|
||||
#include <windows.h>
|
||||
#include <ws2tcpip.h>
|
||||
#include <mswsock.h>
|
||||
#ifdef JANET_MSVC
|
||||
#pragma comment (lib, "Ws2_32.lib")
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#endif
|
||||
#else
|
||||
#include <arpa/inet.h>
|
||||
#include <unistd.h>
|
||||
@@ -173,7 +175,6 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
Janet err;
|
||||
SOCKET lsock = (SOCKET) stream->handle;
|
||||
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
|
||||
@@ -224,7 +225,12 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
#if defined(JANET_LINUX)
|
||||
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||
#else
|
||||
/* On BSDs, CLOEXEC should be inherited from server socket */
|
||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||
#endif
|
||||
if (JSOCKVALID(connfd)) {
|
||||
janet_net_socknoblock(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
@@ -328,6 +334,7 @@ JANET_CORE_FN(cfun_net_sockaddr,
|
||||
"given in the port argument. On Linux, abstract "
|
||||
"unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
|
||||
"return all address that match in an array instead of just the first.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT); /* connect OR listen */
|
||||
janet_arity(argc, 2, 4);
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
@@ -373,6 +380,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
"to specify a connection type, either :stream or :datagram. The default is :stream. "
|
||||
"Bindhost is an optional string to select from what address to make the outgoing "
|
||||
"connection, with the default being the same as using the OS's preferred address. ") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT);
|
||||
janet_arity(argc, 2, 5);
|
||||
|
||||
/* Check arguments */
|
||||
@@ -567,6 +575,7 @@ JANET_CORE_FN(cfun_net_listen,
|
||||
"The type parameter specifies the type of network connection, either "
|
||||
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
|
||||
":stream. The host and port arguments are the same as in net/address.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
@@ -701,7 +710,7 @@ JANET_CORE_FN(cfun_net_getsockname,
|
||||
if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
|
||||
janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
|
||||
}
|
||||
janet_assert(slen <= sizeof(ss), "socket address truncated");
|
||||
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
|
||||
return janet_so_getname(&ss);
|
||||
}
|
||||
|
||||
@@ -717,13 +726,13 @@ JANET_CORE_FN(cfun_net_getpeername,
|
||||
if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
|
||||
janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
|
||||
}
|
||||
janet_assert(slen <= sizeof(ss), "socket address truncated");
|
||||
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
|
||||
return janet_so_getname(&ss);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_address_unpack,
|
||||
"(net/address-unpack address)",
|
||||
"Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
|
||||
"Given an address returned by net/address, return a host, port pair. Unix domain sockets "
|
||||
"will have only the path in the returned tuple.") {
|
||||
janet_fixarity(argc, 1);
|
||||
struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
|
||||
@@ -793,7 +802,7 @@ JANET_CORE_FN(cfun_stream_chunk,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
"(net/recv-from stream nbytes buf &opt timoeut)",
|
||||
"(net/recv-from stream nbytes buf &opt timeout)",
|
||||
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
|
||||
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
|
||||
200
src/core/os.c
200
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose and contributors.
|
||||
* Copyright (c) 2023 Calvin Rose and contributors.
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -118,6 +118,8 @@ JANET_CORE_FN(os_which,
|
||||
"(os/which)",
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"* :windows\n\n"
|
||||
"* :mingw\n\n"
|
||||
"* :cygwin\n\n"
|
||||
"* :macos\n\n"
|
||||
"* :web - Web assembly (emscripten)\n\n"
|
||||
"* :linux\n\n"
|
||||
@@ -130,6 +132,10 @@ JANET_CORE_FN(os_which,
|
||||
(void) argv;
|
||||
#if defined(JANET_OS_NAME)
|
||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||
#elif defined(JANET_MINGW)
|
||||
return janet_ckeywordv("mingw");
|
||||
#elif defined(JANET_CYGWIN)
|
||||
return janet_ckeywordv("cygwin");
|
||||
#elif defined(JANET_WINDOWS)
|
||||
return janet_ckeywordv("windows");
|
||||
#elif defined(JANET_APPLE)
|
||||
@@ -159,6 +165,8 @@ JANET_CORE_FN(os_arch,
|
||||
"* :x64\n\n"
|
||||
"* :arm\n\n"
|
||||
"* :aarch64\n\n"
|
||||
"* :riscv32\n\n"
|
||||
"* :riscv64\n\n"
|
||||
"* :sparc\n\n"
|
||||
"* :wasm\n\n"
|
||||
"* :unknown\n") {
|
||||
@@ -177,6 +185,10 @@ JANET_CORE_FN(os_arch,
|
||||
return janet_ckeywordv("aarch64");
|
||||
#elif defined(_M_ARM) || defined(__arm__)
|
||||
return janet_ckeywordv("arm");
|
||||
#elif (defined(__riscv) && (__riscv_xlen == 64))
|
||||
return janet_ckeywordv("riscv64");
|
||||
#elif (defined(__riscv) && (__riscv_xlen == 32))
|
||||
return janet_ckeywordv("riscv32");
|
||||
#elif (defined(__sparc__))
|
||||
return janet_ckeywordv("sparc");
|
||||
#elif (defined(__ppc__))
|
||||
@@ -188,6 +200,27 @@ JANET_CORE_FN(os_arch,
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Detect the compiler used to build the interpreter */
|
||||
JANET_CORE_FN(os_compiler,
|
||||
"(os/compiler)",
|
||||
"Get the compiler used to compile the interpreter. Returns one of:\n\n"
|
||||
"* :gcc\n\n"
|
||||
"* :clang\n\n"
|
||||
"* :msvc\n\n"
|
||||
"* :unknown\n\n") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#if defined(_MSC_VER)
|
||||
return janet_ckeywordv("msvc");
|
||||
#elif defined(__clang__)
|
||||
return janet_ckeywordv("clang");
|
||||
#elif defined(__GNUC__)
|
||||
return janet_ckeywordv("gcc");
|
||||
#else
|
||||
return janet_ckeywordv("unknown");
|
||||
#endif
|
||||
}
|
||||
|
||||
#undef janet_stringify1
|
||||
#undef janet_stringify
|
||||
|
||||
@@ -209,6 +242,8 @@ JANET_CORE_FN(os_exit,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
JANET_CORE_FN(os_cpu_count,
|
||||
"(os/cpu-count &opt dflt)",
|
||||
"Get an approximate number of CPUs available on for this process to use. If "
|
||||
@@ -250,7 +285,6 @@ JANET_CORE_FN(os_cpu_count,
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
|
||||
@@ -444,7 +478,9 @@ typedef struct {
|
||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
WaitForSingleObject(proc->pHandle, INFINITE);
|
||||
GetExitCodeProcess(proc->pHandle, &args.tag);
|
||||
DWORD exitcode = 0;
|
||||
GetExitCodeProcess(proc->pHandle, &exitcode);
|
||||
args.tag = (int32_t) exitcode;
|
||||
return args;
|
||||
}
|
||||
|
||||
@@ -470,15 +506,7 @@ static int proc_get_status(JanetProc *proc) {
|
||||
/* Function that is called in separate thread to wait on a pid */
|
||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
#ifdef WNOWAIT
|
||||
pid_t result;
|
||||
int status = 0;
|
||||
do {
|
||||
result = waitpid(proc->pid, &status, WNOWAIT);
|
||||
} while (result == -1 && errno == EINTR);
|
||||
#else
|
||||
args.tag = proc_get_status(proc);
|
||||
#endif
|
||||
return args;
|
||||
}
|
||||
|
||||
@@ -489,11 +517,7 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
janet_ev_dec_refcount();
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
if (NULL != proc) {
|
||||
#ifdef WNOWAIT
|
||||
int status = proc_get_status(proc);
|
||||
#else
|
||||
int status = args.tag;
|
||||
#endif
|
||||
proc->return_code = (int32_t) status;
|
||||
proc->flags |= JANET_PROC_WAITED;
|
||||
proc->flags &= ~JANET_PROC_WAITING;
|
||||
@@ -854,6 +878,7 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
|
||||
#endif
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
@@ -913,9 +938,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
janet_panic("failed to create pipes");
|
||||
}
|
||||
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
HANDLE pHandle, tHandle;
|
||||
@@ -994,6 +1016,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
|
||||
#else
|
||||
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
|
||||
for (int32_t i = 0; i < exargs.len; i++)
|
||||
child_argv[i] = janet_getcstring(exargs.items, i);
|
||||
@@ -1121,8 +1146,8 @@ JANET_CORE_FN(os_spawn,
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
|
||||
"same arguments as `os/execute`. Does not wait for the process. "
|
||||
"For each of the :in, :out, and :err keys to the `env` argument, one "
|
||||
"can also pass in the keyword `:pipe`"
|
||||
"to get streams for standard IO of the subprocess that can be read from and written to."
|
||||
"can also pass in the keyword `:pipe` "
|
||||
"to get streams for standard IO of the subprocess that can be read from and written to. "
|
||||
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
|
||||
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
||||
"subprocess or `(os/proc-kill proc)`.") {
|
||||
@@ -1147,6 +1172,7 @@ static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||
JANET_CORE_FN(os_shell,
|
||||
"(os/shell str)",
|
||||
"Pass a command string str directly to the system shell.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? janet_getcstring(argv, 0)
|
||||
@@ -1166,6 +1192,7 @@ JANET_CORE_FN(os_shell,
|
||||
JANET_CORE_FN(os_environ,
|
||||
"(os/environ)",
|
||||
"Get a copy of the OS environment table.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
int32_t nenv = 0;
|
||||
@@ -1197,6 +1224,7 @@ JANET_CORE_FN(os_environ,
|
||||
JANET_CORE_FN(os_getenv,
|
||||
"(os/getenv variable &opt dflt)",
|
||||
"Get the string value of an environment variable.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
@@ -1220,6 +1248,7 @@ JANET_CORE_FN(os_setenv,
|
||||
#define SETENV(K,V) setenv(K, V, 1)
|
||||
#define UNSETENV(K) unsetenv(K)
|
||||
#endif
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *ks = janet_getcstring(argv, 0);
|
||||
const char *vs = janet_optcstring(argv, argc, 1, NULL);
|
||||
@@ -1247,6 +1276,7 @@ JANET_CORE_FN(os_clock,
|
||||
"(os/clock)",
|
||||
"Return the number of whole + fractional seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non-decreasing in real time.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
@@ -1336,7 +1366,7 @@ JANET_CORE_FN(os_date,
|
||||
time_t t;
|
||||
struct tm t_infos;
|
||||
struct tm *t_info = NULL;
|
||||
if (argc) {
|
||||
if (argc && !janet_checktype(argv[0], JANET_NIL)) {
|
||||
int64_t integer = janet_getinteger64(argv, 0);
|
||||
t = (time_t) integer;
|
||||
} else {
|
||||
@@ -1488,6 +1518,7 @@ JANET_CORE_FN(os_link,
|
||||
"Iff symlink is truthy, creates a symlink. "
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@@ -1506,6 +1537,7 @@ JANET_CORE_FN(os_link,
|
||||
JANET_CORE_FN(os_symlink,
|
||||
"(os/symlink oldpath newpath)",
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as `(os/link oldpath newpath true)`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@@ -1528,6 +1560,7 @@ JANET_CORE_FN(os_mkdir,
|
||||
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
|
||||
"errors otherwise.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1543,6 +1576,7 @@ JANET_CORE_FN(os_mkdir,
|
||||
JANET_CORE_FN(os_rmdir,
|
||||
"(os/rmdir path)",
|
||||
"Delete a directory. The directory must be empty to succeed.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1557,6 +1591,7 @@ JANET_CORE_FN(os_rmdir,
|
||||
JANET_CORE_FN(os_cd,
|
||||
"(os/cd path)",
|
||||
"Change current directory to path. Returns nil on success, errors on failure.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1572,6 +1607,7 @@ JANET_CORE_FN(os_touch,
|
||||
"(os/touch path &opt actime modtime)",
|
||||
"Update the access time and modification times for a file. By default, sets "
|
||||
"times to the current time.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
struct utimbuf timebuf, *bufp;
|
||||
@@ -1780,9 +1816,11 @@ static Janet os_stat_changed(jstat_t *st) {
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
static Janet os_stat_blocks(jstat_t *st) {
|
||||
(void) st;
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
static Janet os_stat_blocksize(jstat_t *st) {
|
||||
(void) st;
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
#else
|
||||
@@ -1819,14 +1857,13 @@ static const struct OsStatGetter os_stat_getters[] = {
|
||||
};
|
||||
|
||||
static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
JanetTable *tab = NULL;
|
||||
int getall = 1;
|
||||
const uint8_t *key;
|
||||
const uint8_t *key = NULL;
|
||||
if (argc == 2) {
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
getall = 0;
|
||||
key = janet_getkeyword(argv, 1);
|
||||
} else {
|
||||
tab = janet_gettable(argv, 1);
|
||||
@@ -1852,7 +1889,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
if (getall) {
|
||||
if (NULL == key) {
|
||||
/* Put results in table */
|
||||
for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
|
||||
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(&st));
|
||||
@@ -1872,7 +1909,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
JANET_CORE_FN(os_stat,
|
||||
"(os/stat path &opt tab|key)",
|
||||
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
|
||||
"only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
|
||||
"* :dev - the device that the file is on\n\n"
|
||||
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
|
||||
"* :int-permissions - A Unix permission integer like 8r744\n\n"
|
||||
@@ -1902,6 +1939,7 @@ JANET_CORE_FN(os_chmod,
|
||||
"`os/perm-string`, or an integer as returned by `os/perm-int`. "
|
||||
"When `mode` is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1917,6 +1955,7 @@ JANET_CORE_FN(os_chmod,
|
||||
JANET_CORE_FN(os_umask,
|
||||
"(os/umask mask)",
|
||||
"Set a new umask, returns the old umask.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 1);
|
||||
int mask = (int) os_getmode(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1932,6 +1971,7 @@ JANET_CORE_FN(os_dir,
|
||||
"(os/dir dir &opt array)",
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the file name or directory name and no prefix.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
|
||||
@@ -1969,6 +2009,7 @@ JANET_CORE_FN(os_dir,
|
||||
JANET_CORE_FN(os_rename,
|
||||
"(os/rename oldname newname)",
|
||||
"Rename a file on disk to a new path. Returns nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 2);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
const char *dest = janet_getcstring(argv, 1);
|
||||
@@ -1982,7 +2023,8 @@ JANET_CORE_FN(os_rename,
|
||||
JANET_CORE_FN(os_realpath,
|
||||
"(os/realpath path)",
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string. Will raise an error on Windows.") {
|
||||
"Returns an absolute path as a string.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_NO_REALPATH
|
||||
@@ -2036,23 +2078,23 @@ JANET_CORE_FN(os_open,
|
||||
"Allowed flags are as follows:\n\n"
|
||||
" * :r - open this file for reading\n"
|
||||
" * :w - open this file for writing\n"
|
||||
" * :c - create a new file (O_CREATE)\n"
|
||||
" * :e - fail if the file exists (O_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
||||
" * :c - create a new file (O\\_CREATE)\n"
|
||||
" * :e - fail if the file exists (O\\_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
|
||||
"Posix-only flags:\n\n"
|
||||
" * :a - append to a file (O_APPEND)\n"
|
||||
" * :x - O_SYNC\n"
|
||||
" * :C - O_NOCTTY\n\n"
|
||||
" * :a - append to a file (O\\_APPEND)\n"
|
||||
" * :x - O\\_SYNC\n"
|
||||
" * :C - O\\_NOCTTY\n\n"
|
||||
"Windows-only flags:\n\n"
|
||||
" * :R - share reads (FILE_SHARE_READ)\n"
|
||||
" * :W - share writes (FILE_SHARE_WRITE)\n"
|
||||
" * :D - share deletes (FILE_SHARE_DELETE)\n"
|
||||
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
|
||||
" * :O - FILE_ATTRIBUTE_READONLY\n"
|
||||
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
|
||||
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
|
||||
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
||||
" * :b - FILE_FLAG_NO_BUFFERING\n") {
|
||||
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
|
||||
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
|
||||
" * :D - share deletes (FILE\\_SHARE\\_DELETE)\n"
|
||||
" * :H - FILE\\_ATTRIBUTE\\_HIDDEN\n"
|
||||
" * :O - FILE\\_ATTRIBUTE\\_READONLY\n"
|
||||
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
|
||||
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
|
||||
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
|
||||
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
||||
@@ -2060,6 +2102,7 @@ JANET_CORE_FN(os_open,
|
||||
uint32_t stream_flags = 0;
|
||||
JanetHandle fd;
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) mode;
|
||||
DWORD desiredAccess = 0;
|
||||
DWORD shareMode = 0;
|
||||
DWORD creationDisp = 0;
|
||||
@@ -2076,19 +2119,23 @@ JANET_CORE_FN(os_open,
|
||||
case 'r':
|
||||
desiredAccess |= GENERIC_READ;
|
||||
stream_flags |= JANET_STREAM_READABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
case 'w':
|
||||
desiredAccess |= GENERIC_WRITE;
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'c':
|
||||
creatUnix |= OCREAT;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'e':
|
||||
creatUnix |= OEXCL;
|
||||
break;
|
||||
case 't':
|
||||
creatUnix |= OTRUNC;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
/* Windows only flags */
|
||||
case 'D':
|
||||
@@ -2149,30 +2196,32 @@ JANET_CORE_FN(os_open,
|
||||
#ifdef JANET_LINUX
|
||||
open_flags |= O_CLOEXEC;
|
||||
#endif
|
||||
int read_flag = 0;
|
||||
int write_flag = 0;
|
||||
for (const uint8_t *c = opt_flags; *c; c++) {
|
||||
switch (*c) {
|
||||
default:
|
||||
break;
|
||||
case 'r':
|
||||
open_flags = (open_flags & O_WRONLY)
|
||||
? ((open_flags & ~O_WRONLY) | O_RDWR)
|
||||
: (open_flags | O_RDONLY);
|
||||
read_flag = 1;
|
||||
stream_flags |= JANET_STREAM_READABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
case 'w':
|
||||
open_flags = (open_flags & O_RDONLY)
|
||||
? ((open_flags & ~O_RDONLY) | O_RDWR)
|
||||
: (open_flags | O_WRONLY);
|
||||
write_flag = 1;
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'c':
|
||||
open_flags |= O_CREAT;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'e':
|
||||
open_flags |= O_EXCL;
|
||||
break;
|
||||
case 't':
|
||||
open_flags |= O_TRUNC;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
/* posix only */
|
||||
case 'x':
|
||||
@@ -2186,6 +2235,15 @@ JANET_CORE_FN(os_open,
|
||||
break;
|
||||
}
|
||||
}
|
||||
/* If both read and write, fix up to O_RDWR */
|
||||
if (read_flag && !write_flag) {
|
||||
open_flags |= O_RDONLY;
|
||||
} else if (write_flag && !read_flag) {
|
||||
open_flags |= O_WRONLY;
|
||||
} else {
|
||||
open_flags = O_RDWR;
|
||||
}
|
||||
|
||||
do {
|
||||
fd = open(path, open_flags, mode);
|
||||
} while (fd == -1 && errno == EINTR);
|
||||
@@ -2236,49 +2294,67 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/exit", os_exit),
|
||||
JANET_CORE_REG("os/which", os_which),
|
||||
JANET_CORE_REG("os/arch", os_arch),
|
||||
JANET_CORE_REG("os/compiler", os_compiler),
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
/* misc (un-sandboxed) */
|
||||
JANET_CORE_REG("os/cpu-count", os_cpu_count),
|
||||
JANET_CORE_REG("os/cwd", os_cwd),
|
||||
JANET_CORE_REG("os/cryptorand", os_cryptorand),
|
||||
JANET_CORE_REG("os/perm-string", os_permission_string),
|
||||
JANET_CORE_REG("os/perm-int", os_permission_int),
|
||||
JANET_CORE_REG("os/mktime", os_mktime),
|
||||
JANET_CORE_REG("os/time", os_time), /* not high resolution */
|
||||
JANET_CORE_REG("os/date", os_date), /* not high resolution */
|
||||
JANET_CORE_REG("os/sleep", os_sleep),
|
||||
|
||||
/* env functions */
|
||||
JANET_CORE_REG("os/environ", os_environ),
|
||||
JANET_CORE_REG("os/getenv", os_getenv),
|
||||
JANET_CORE_REG("os/setenv", os_setenv),
|
||||
|
||||
/* fs read */
|
||||
JANET_CORE_REG("os/dir", os_dir),
|
||||
JANET_CORE_REG("os/stat", os_stat),
|
||||
JANET_CORE_REG("os/lstat", os_lstat),
|
||||
JANET_CORE_REG("os/chmod", os_chmod),
|
||||
JANET_CORE_REG("os/touch", os_touch),
|
||||
JANET_CORE_REG("os/realpath", os_realpath),
|
||||
JANET_CORE_REG("os/cd", os_cd),
|
||||
JANET_CORE_REG("os/cpu-count", os_cpu_count),
|
||||
#ifndef JANET_NO_UMASK
|
||||
JANET_CORE_REG("os/umask", os_umask),
|
||||
#endif
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
JANET_CORE_REG("os/readlink", os_readlink),
|
||||
#endif
|
||||
|
||||
/* fs write */
|
||||
JANET_CORE_REG("os/mkdir", os_mkdir),
|
||||
JANET_CORE_REG("os/rmdir", os_rmdir),
|
||||
JANET_CORE_REG("os/rm", os_remove),
|
||||
JANET_CORE_REG("os/link", os_link),
|
||||
JANET_CORE_REG("os/rename", os_rename),
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
JANET_CORE_REG("os/symlink", os_symlink),
|
||||
JANET_CORE_REG("os/readlink", os_readlink),
|
||||
#endif
|
||||
|
||||
/* processes */
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
JANET_CORE_REG("os/execute", os_execute),
|
||||
JANET_CORE_REG("os/spawn", os_spawn),
|
||||
JANET_CORE_REG("os/shell", os_shell),
|
||||
/* no need to sandbox process management if you can't create processes
|
||||
* (allows for limited functionality if use exposes C-functions to create specific processes) */
|
||||
JANET_CORE_REG("os/proc-wait", os_proc_wait),
|
||||
JANET_CORE_REG("os/proc-kill", os_proc_kill),
|
||||
JANET_CORE_REG("os/proc-close", os_proc_close),
|
||||
#endif
|
||||
JANET_CORE_REG("os/setenv", os_setenv),
|
||||
JANET_CORE_REG("os/time", os_time),
|
||||
JANET_CORE_REG("os/mktime", os_mktime),
|
||||
|
||||
/* high resolution timers */
|
||||
JANET_CORE_REG("os/clock", os_clock),
|
||||
JANET_CORE_REG("os/sleep", os_sleep),
|
||||
JANET_CORE_REG("os/cwd", os_cwd),
|
||||
JANET_CORE_REG("os/cryptorand", os_cryptorand),
|
||||
JANET_CORE_REG("os/date", os_date),
|
||||
JANET_CORE_REG("os/rename", os_rename),
|
||||
JANET_CORE_REG("os/realpath", os_realpath),
|
||||
JANET_CORE_REG("os/perm-string", os_permission_string),
|
||||
JANET_CORE_REG("os/perm-int", os_permission_int),
|
||||
|
||||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/open", os_open),
|
||||
JANET_CORE_REG("os/open", os_open), /* fs read and write */
|
||||
JANET_CORE_REG("os/pipe", os_pipe),
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -206,6 +206,37 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
}
|
||||
}
|
||||
|
||||
static void delim_error(JanetParser *parser, size_t stack_index, char c, const char *msg) {
|
||||
JanetParseState *s = parser->states + stack_index;
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
if (msg) {
|
||||
janet_buffer_push_cstring(buffer, msg);
|
||||
}
|
||||
if (c) {
|
||||
janet_buffer_push_u8(buffer, c);
|
||||
}
|
||||
if (stack_index > 0) {
|
||||
janet_buffer_push_cstring(buffer, ", ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
}
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
}
|
||||
|
||||
static int checkescape(uint8_t c) {
|
||||
switch (c) {
|
||||
default:
|
||||
@@ -612,7 +643,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
case '}': {
|
||||
Janet ds;
|
||||
if (p->statecount == 1) {
|
||||
p->error = "unexpected delimiter";
|
||||
delim_error(p, 0, c, "unexpected closing delimiter ");
|
||||
return 1;
|
||||
}
|
||||
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||
@@ -633,7 +664,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
ds = close_struct(p, state);
|
||||
}
|
||||
} else {
|
||||
p->error = "mismatched delimiter";
|
||||
delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
|
||||
return 1;
|
||||
}
|
||||
popstate(p, ds);
|
||||
@@ -684,26 +715,7 @@ void janet_parser_eof(JanetParser *parser) {
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
JanetParseState *s = parser->states + (parser->statecount - 1);
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
|
||||
}
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -211,9 +211,10 @@ tail:
|
||||
}
|
||||
|
||||
case RULE_SET: {
|
||||
if (text >= s->text_end) return NULL;
|
||||
uint32_t word = rule[1 + (text[0] >> 5)];
|
||||
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
||||
return (text < s->text_end && (word & mask))
|
||||
return (word & mask)
|
||||
? text + 1
|
||||
: NULL;
|
||||
}
|
||||
@@ -260,30 +261,52 @@ tail:
|
||||
goto tail;
|
||||
}
|
||||
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT: {
|
||||
case RULE_IF: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
up1(s);
|
||||
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
||||
if (!result) return NULL;
|
||||
rule = rule_b;
|
||||
goto tail;
|
||||
}
|
||||
case RULE_IFNOT: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||
down1(s);
|
||||
CapState cs = cap_save(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
if (!!result) {
|
||||
up1(s);
|
||||
return NULL;
|
||||
} else {
|
||||
cap_load(s, cs);
|
||||
up1(s);
|
||||
rule = rule_b;
|
||||
goto tail;
|
||||
}
|
||||
}
|
||||
|
||||
case RULE_NOT: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
down1(s);
|
||||
CapState cs = cap_save(s);
|
||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||
up1(s);
|
||||
return (result) ? NULL : text;
|
||||
if (result) {
|
||||
up1(s);
|
||||
return NULL;
|
||||
} else {
|
||||
cap_load(s, cs);
|
||||
up1(s);
|
||||
return text;
|
||||
}
|
||||
}
|
||||
|
||||
case RULE_THRU:
|
||||
case RULE_TO: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint8_t *next_text;
|
||||
const uint8_t *next_text = NULL;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= s->text_end) {
|
||||
@@ -1011,7 +1034,7 @@ static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
|
||||
return;
|
||||
error:
|
||||
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
|
||||
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[1]);
|
||||
}
|
||||
|
||||
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
||||
@@ -1661,7 +1684,9 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
}
|
||||
|
||||
static void peg_call_reset(PegCall *c) {
|
||||
c->s.depth = JANET_RECURSION_GUARD;
|
||||
c->s.captures->count = 0;
|
||||
c->s.tagged_captures->count = 0;
|
||||
c->s.scratch->count = 0;
|
||||
c->s.tags->count = 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -30,6 +30,7 @@
|
||||
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <inttypes.h>
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
* is simple and not that flexible, but fast. */
|
||||
@@ -108,7 +109,7 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
pbuf.p = pointer;
|
||||
*c++ = '<';
|
||||
/* Maximum of 32 bytes for abstract type name */
|
||||
for (i = 0; title[i] && i < 32; ++i)
|
||||
for (i = 0; i < 32 && title[i]; ++i)
|
||||
*c++ = ((uint8_t *)title) [i];
|
||||
*c++ = ' ';
|
||||
*c++ = '0';
|
||||
@@ -750,20 +751,46 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
||||
|
||||
#define MAX_ITEM 256
|
||||
#define FMT_FLAGS "-+ #0"
|
||||
#define FMT_REPLACE_INTTYPES "diouxX"
|
||||
#define MAX_FORMAT 32
|
||||
|
||||
struct FmtMapping {
|
||||
char c;
|
||||
const char *mapping;
|
||||
};
|
||||
|
||||
/* Janet uses fixed width integer types for most things, so map
|
||||
* format specifiers to these fixed sizes */
|
||||
static const struct FmtMapping format_mappings[] = {
|
||||
{'d', PRId64},
|
||||
{'i', PRIi64},
|
||||
{'o', PRIo64},
|
||||
{'u', PRIu64},
|
||||
{'x', PRIx64},
|
||||
{'X', PRIX64},
|
||||
};
|
||||
|
||||
static const char *get_fmt_mapping(char c) {
|
||||
for (size_t i = 0; i < (sizeof(format_mappings) / sizeof(struct FmtMapping)); i++) {
|
||||
if (format_mappings[i].c == c)
|
||||
return format_mappings[i].mapping;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static const char *scanformat(
|
||||
const char *strfrmt,
|
||||
char *form,
|
||||
char width[3],
|
||||
char precision[3]) {
|
||||
const char *p = strfrmt;
|
||||
|
||||
/* Parse strfrmt */
|
||||
memset(width, '\0', 3);
|
||||
memset(precision, '\0', 3);
|
||||
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
||||
p++; /* skip flags */
|
||||
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
|
||||
janet_panic("invalid format (repeated flags)");
|
||||
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
|
||||
if (isdigit((int)(*p)))
|
||||
width[0] = *p++; /* skip width */
|
||||
if (isdigit((int)(*p)))
|
||||
@@ -777,10 +804,22 @@ static const char *scanformat(
|
||||
}
|
||||
if (isdigit((int)(*p)))
|
||||
janet_panic("invalid format (width or precision too long)");
|
||||
|
||||
/* Write to form - replace characters with fixed size stuff */
|
||||
*(form++) = '%';
|
||||
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
|
||||
form += (p - strfrmt) + 1;
|
||||
const char *p2 = strfrmt;
|
||||
while (p2 <= p) {
|
||||
if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) {
|
||||
const char *mapping = get_fmt_mapping(*p2++);
|
||||
size_t len = strlen(mapping);
|
||||
strcpy(form, mapping);
|
||||
form += len;
|
||||
} else {
|
||||
*(form++) = *(p2++);
|
||||
}
|
||||
}
|
||||
*form = '\0';
|
||||
|
||||
return p;
|
||||
}
|
||||
|
||||
@@ -805,11 +844,16 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'i': {
|
||||
int64_t n = va_arg(args, long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
case 'X':
|
||||
case 'o':
|
||||
case 'u': {
|
||||
uint64_t n = va_arg(args, unsigned long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
@@ -963,11 +1007,16 @@ void janet_buffer_format(
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'i': {
|
||||
int64_t n = janet_getinteger64(argv, arg);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = janet_getinteger(argv, arg);
|
||||
case 'X':
|
||||
case 'o':
|
||||
case 'u': {
|
||||
uint64_t n = janet_getuinteger64(argv, arg);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -80,9 +80,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
const char *e = janet_parser_error(&parser);
|
||||
errflags |= 0x04;
|
||||
ret = janet_cstringv(e);
|
||||
size_t line = parser.line;
|
||||
size_t col = parser.column;
|
||||
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
|
||||
int32_t line = (int32_t) parser.line;
|
||||
int32_t col = (int32_t) parser.column;
|
||||
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
||||
done = 1;
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -813,7 +813,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot ret;
|
||||
Janet head;
|
||||
JanetScope fnscope;
|
||||
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||
int32_t paramcount, argi, parami, arity, min_arity = 0, max_arity, defindex, i;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
const Janet *params;
|
||||
const char *errmsg = NULL;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,6 +25,12 @@
|
||||
|
||||
#include <stdint.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
typedef int64_t JanetTimestamp;
|
||||
|
||||
typedef struct JanetScratch {
|
||||
@@ -54,7 +60,7 @@ typedef struct {
|
||||
int is_error;
|
||||
} JanetTimeout;
|
||||
|
||||
/* Registry table for C functions - containts metadata that can
|
||||
/* Registry table for C functions - contains metadata that can
|
||||
* be looked up by cfunction pointer. All strings here are pointing to
|
||||
* static memory not managed by Janet. */
|
||||
typedef struct {
|
||||
@@ -85,7 +91,7 @@ struct JanetVM {
|
||||
int auto_suspend;
|
||||
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
* Set and unset by functions in vm.c */
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *root_fiber;
|
||||
|
||||
@@ -101,7 +107,7 @@ struct JanetVM {
|
||||
size_t registry_count;
|
||||
int registry_dirty;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
/* Registry for abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
JanetTable *abstract_registry;
|
||||
|
||||
@@ -129,6 +135,9 @@ struct JanetVM {
|
||||
size_t scratch_cap;
|
||||
size_t scratch_len;
|
||||
|
||||
/* Sandbox flags */
|
||||
uint32_t sandbox_flags;
|
||||
|
||||
/* Random number generator */
|
||||
JanetRNG rng;
|
||||
|
||||
@@ -152,16 +161,19 @@ struct JanetVM {
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
int epoll;
|
||||
int timerfd;
|
||||
int timer_enabled;
|
||||
#elif defined(JANET_EV_KQUEUE)
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
int kq;
|
||||
int timer;
|
||||
int timer_enabled;
|
||||
#else
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
struct pollfd *fds;
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -530,7 +530,7 @@ JANET_CORE_FN(cfun_string_join,
|
||||
|
||||
JANET_CORE_FN(cfun_string_format,
|
||||
"(string/format format & values)",
|
||||
"Similar to `snprintf`, but specialized for operating with Janet values. Returns "
|
||||
"Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
|
||||
"a new string.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(0);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -36,6 +36,15 @@
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#ifdef JANET_DYNAMIC_MODULES
|
||||
#include <psapi.h>
|
||||
#ifdef JANET_MSVC
|
||||
#pragma comment (lib, "Psapi.lib")
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_APPLE
|
||||
#include <AvailabilityMacros.h>
|
||||
#endif
|
||||
@@ -694,15 +703,25 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
/* Read both strings and buffer as unsigned character array + int32_t len.
|
||||
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
||||
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
|
||||
janet_checktype(str, JANET_KEYWORD)) {
|
||||
JanetType t = janet_type(str);
|
||||
if (t == JANET_STRING || t == JANET_SYMBOL || t == JANET_KEYWORD) {
|
||||
*data = janet_unwrap_string(str);
|
||||
*len = janet_string_length(janet_unwrap_string(str));
|
||||
return 1;
|
||||
} else if (janet_checktype(str, JANET_BUFFER)) {
|
||||
} else if (t == JANET_BUFFER) {
|
||||
*data = janet_unwrap_buffer(str)->data;
|
||||
*len = janet_unwrap_buffer(str)->count;
|
||||
return 1;
|
||||
} else if (t == JANET_ABSTRACT) {
|
||||
void *abst = janet_unwrap_abstract(str);
|
||||
const JanetAbstractType *atype = janet_abstract_type(abst);
|
||||
if (NULL == atype->bytes) {
|
||||
return 0;
|
||||
}
|
||||
JanetByteView view = atype->bytes(abst, janet_abstract_size(abst));
|
||||
*data = view.bytes;
|
||||
*len = view.len;
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -846,13 +865,13 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
return -1;
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
for (int32_t j = 0; (j < (int32_t) sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
out[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
@@ -903,7 +922,15 @@ char *get_processed_name(const char *name) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
|
||||
const char *error_clib(void) {
|
||||
return "dynamic modules not supported";
|
||||
}
|
||||
|
||||
#else
|
||||
#if defined(JANET_WINDOWS)
|
||||
|
||||
static char error_clib_buf[256];
|
||||
char *error_clib(void) {
|
||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
@@ -920,6 +947,36 @@ Clib load_clib(const char *name) {
|
||||
return LoadLibrary(name);
|
||||
}
|
||||
}
|
||||
|
||||
void free_clib(HINSTANCE clib) {
|
||||
if (clib != GetModuleHandle(NULL)) {
|
||||
FreeLibrary(clib);
|
||||
}
|
||||
}
|
||||
|
||||
void *symbol_clib(HINSTANCE clib, const char *sym) {
|
||||
if (clib != GetModuleHandle(NULL)) {
|
||||
return GetProcAddress(clib, sym);
|
||||
} else {
|
||||
/* Look up symbols from all loaded modules */
|
||||
HMODULE hMods[1024];
|
||||
DWORD needed = 0;
|
||||
if (EnumProcessModules(GetCurrentProcess(), hMods, sizeof(hMods), &needed)) {
|
||||
needed /= sizeof(HMODULE);
|
||||
for (DWORD i = 0; i < needed; i++) {
|
||||
void *address = GetProcAddress(hMods[i], sym);
|
||||
if (NULL != address) {
|
||||
return address;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
janet_panicf("ffi: %s", error_clib());
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Alloc function macro fills */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -135,13 +135,13 @@ int janet_gettime(struct timespec *spec);
|
||||
typedef int Clib;
|
||||
#define load_clib(name) ((void) name, 0)
|
||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||
#define error_clib() "dynamic libraries not supported"
|
||||
const char *error_clib(void);
|
||||
#define free_clib(c) ((void) (c), 0)
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#include <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
#define free_clib(c) FreeLibrary((c))
|
||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
||||
void *symbol_clib(Clib clib, const char *sym);
|
||||
void free_clib(Clib clib);
|
||||
Clib load_clib(const char *name);
|
||||
char *error_clib(void);
|
||||
#else
|
||||
@@ -150,7 +150,7 @@ typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#define free_clib(lib) dlclose((lib))
|
||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||
#define error_clib() dlerror()
|
||||
#define error_clib dlerror
|
||||
#endif
|
||||
char *get_processed_name(const char *name);
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -272,6 +272,7 @@ int janet_equals(Janet x, Janet y) {
|
||||
const Janet *t1 = janet_unwrap_tuple(x);
|
||||
const Janet *t2 = janet_unwrap_tuple(y);
|
||||
if (t1 == t2) break;
|
||||
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(t1) ^ janet_tuple_flag(t2))) return 0;
|
||||
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
|
||||
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
|
||||
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
|
||||
@@ -295,6 +296,15 @@ int janet_equals(Janet x, Janet y) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
static uint64_t murmur64(uint64_t h) {
|
||||
h ^= h >> 33;
|
||||
h *= 0xff51afd7ed558ccdUL;
|
||||
h ^= h >> 33;
|
||||
h *= 0xc4ceb9fe1a85ec53UL;
|
||||
h ^= h >> 33;
|
||||
return h;
|
||||
}
|
||||
|
||||
/* Computes a hash value for a function */
|
||||
int32_t janet_hash(Janet x) {
|
||||
int32_t hash = 0;
|
||||
@@ -312,6 +322,7 @@ int32_t janet_hash(Janet x) {
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
hash = janet_tuple_hash(janet_unwrap_tuple(x));
|
||||
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
@@ -341,14 +352,11 @@ int32_t janet_hash(Janet x) {
|
||||
default:
|
||||
if (sizeof(double) == sizeof(void *)) {
|
||||
/* Assuming 8 byte pointer (8 byte aligned) */
|
||||
uint64_t i = janet_u64(x);
|
||||
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
|
||||
uint32_t hi = (uint32_t)(i >> 32);
|
||||
uint32_t hilo = (hi ^ lo) * 2654435769u;
|
||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
||||
uint64_t i = murmur64(janet_u64(x));
|
||||
hash = (int32_t)(i >> 32);
|
||||
} else {
|
||||
/* Assuming 4 byte pointer (or smaller) */
|
||||
ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
|
||||
uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
|
||||
uint32_t hilo = (uint32_t) diff * 2654435769u;
|
||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
||||
}
|
||||
@@ -406,6 +414,9 @@ int janet_compare(Janet x, Janet y) {
|
||||
case JANET_TUPLE: {
|
||||
const Janet *lhs = janet_unwrap_tuple(x);
|
||||
const Janet *rhs = janet_unwrap_tuple(y);
|
||||
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(lhs) ^ janet_tuple_flag(rhs))) {
|
||||
return (janet_tuple_flag(lhs) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : -1;
|
||||
}
|
||||
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
|
||||
break;
|
||||
}
|
||||
@@ -645,6 +656,15 @@ int32_t janet_length(Janet x) {
|
||||
case JANET_TABLE:
|
||||
return janet_unwrap_table(x)->count;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if (len > INT32_MAX) {
|
||||
janet_panicf("invalid integer length %u", len);
|
||||
}
|
||||
return (int32_t)(len);
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
Janet len = janet_mcall("length", 1, argv);
|
||||
if (!janet_checkint(len))
|
||||
@@ -673,6 +693,16 @@ Janet janet_lengthv(Janet x) {
|
||||
case JANET_TABLE:
|
||||
return janet_wrap_integer(janet_unwrap_table(x)->count);
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
|
||||
return janet_wrap_number((double) len);
|
||||
} else {
|
||||
janet_panicf("integer length %u too large", len);
|
||||
}
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
return janet_mcall("length", 1, argv);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -220,14 +220,14 @@
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
janet_eprintf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
janet_eprintf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", argv[i]);
|
||||
janet_eprintf(" %p", argv[i]);
|
||||
}
|
||||
janet_printf(")\n");
|
||||
janet_eprintf(")\n");
|
||||
}
|
||||
|
||||
/* Invoke a method once we have looked it up */
|
||||
@@ -918,7 +918,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
int32_t i;
|
||||
for (i = 0; i < elen; ++i) {
|
||||
int32_t inherit = fd->environments[i];
|
||||
if (inherit == -1) {
|
||||
if (inherit == -1 || inherit >= func->def->environments_length) {
|
||||
JanetStackFrame *frame = janet_stack_frame(stack);
|
||||
if (!frame->env) {
|
||||
/* Lazy capture of current stack frame */
|
||||
@@ -1285,6 +1285,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
return signal;
|
||||
}
|
||||
|
||||
static Janet void_cfunction(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("placeholder");
|
||||
}
|
||||
|
||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Check entry conditions */
|
||||
if (!janet_vm.fiber)
|
||||
@@ -1292,9 +1298,17 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
if (janet_vm.stackn >= JANET_RECURSION_GUARD)
|
||||
janet_panic("C stack recursed too deeply");
|
||||
|
||||
/* Dirty stack */
|
||||
int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
|
||||
if (dirty_stack) {
|
||||
janet_fiber_cframe(janet_vm.fiber, void_cfunction);
|
||||
}
|
||||
|
||||
/* Tracing */
|
||||
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
janet_vm.stackn++;
|
||||
vm_do_trace(fun, argc, argv);
|
||||
janet_vm.stackn--;
|
||||
}
|
||||
|
||||
/* Push frame */
|
||||
@@ -1322,6 +1336,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Teardown */
|
||||
janet_vm.stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
if (dirty_stack) {
|
||||
janet_fiber_popframe(janet_vm.fiber);
|
||||
janet_vm.fiber->stacktop += dirty_stack;
|
||||
}
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
janet_panicv(*janet_vm.return_reg);
|
||||
@@ -1541,6 +1559,9 @@ int janet_init(void) {
|
||||
janet_vm.scratch_len = 0;
|
||||
janet_vm.scratch_cap = 0;
|
||||
|
||||
/* Sandbox flags */
|
||||
janet_vm.sandbox_flags = 0;
|
||||
|
||||
/* Initialize registry */
|
||||
janet_vm.registry = NULL;
|
||||
janet_vm.registry_cap = 0;
|
||||
@@ -1582,6 +1603,18 @@ int janet_init(void) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Disable some features at runtime with no way to re-enable them */
|
||||
void janet_sandbox(uint32_t flags) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SANDBOX);
|
||||
janet_vm.sandbox_flags |= flags;
|
||||
}
|
||||
|
||||
void janet_sandbox_assert(uint32_t forbidden_flags) {
|
||||
if (forbidden_flags & janet_vm.sandbox_flags) {
|
||||
janet_panic("operation forbidden by sandbox");
|
||||
}
|
||||
}
|
||||
|
||||
/* Clear all memory associated with the VM */
|
||||
void janet_deinit(void) {
|
||||
janet_clear_memory();
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -67,6 +67,11 @@ extern "C" {
|
||||
#define JANET_LINUX 1
|
||||
#endif
|
||||
|
||||
/* Check for Cygwin */
|
||||
#if defined(__CYGWIN__)
|
||||
#define JANET_CYGWIN 1
|
||||
#endif
|
||||
|
||||
/* Check Unix */
|
||||
#if defined(_AIX) \
|
||||
|| defined(__APPLE__) /* Darwin */ \
|
||||
@@ -87,6 +92,16 @@ extern "C" {
|
||||
#define JANET_WINDOWS 1
|
||||
#endif
|
||||
|
||||
/* Check if compiling with MSVC - else assume a GCC-like compiler by default */
|
||||
#ifdef _MSC_VER
|
||||
#define JANET_MSVC
|
||||
#endif
|
||||
|
||||
/* Check Mingw 32-bit and 64-bit */
|
||||
#ifdef __MINGW32__
|
||||
#define JANET_MINGW
|
||||
#endif
|
||||
|
||||
/* Check 64-bit vs 32-bit */
|
||||
#if ((defined(__x86_64__) || defined(_M_X64)) \
|
||||
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
|
||||
@@ -96,7 +111,8 @@ extern "C" {
|
||||
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|
||||
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
||||
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
||||
|| defined(__aarch64__) /* ARM 64-bit */
|
||||
|| defined(__aarch64__) /* ARM 64-bit */ \
|
||||
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|
||||
#define JANET_64 1
|
||||
#else
|
||||
#define JANET_32 1
|
||||
@@ -164,13 +180,20 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/* Enable or disable the FFI library. Currently, FFI only enabled on
|
||||
* x86-64, non-windows operating systems. */
|
||||
* x86-64 operating systems. */
|
||||
#ifndef JANET_NO_FFI
|
||||
#if !defined(JANET_WINDOWS) && !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
|
||||
#if !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
|
||||
#define JANET_FFI
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* If FFI is enabled and FFI-JIT is not disabled... */
|
||||
#ifdef JANET_FFI
|
||||
#ifndef JANET_NO_FFI_JIT
|
||||
#define JANET_FFI_JIT
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Enable or disable the assembler. Enabled by default. */
|
||||
#ifndef JANET_NO_ASSEMBLER
|
||||
#define JANET_ASSEMBLER
|
||||
@@ -236,7 +259,7 @@ extern "C" {
|
||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||
#define JANET_MAX_PROTO_DEPTH 200
|
||||
|
||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||
/* Prevent macros to expand too deeply and error out. */
|
||||
#define JANET_MAX_MACRO_EXPAND 200
|
||||
|
||||
/* Define default max stack size for stacks before raising a stack overflow error.
|
||||
@@ -257,10 +280,11 @@ extern "C" {
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
#elif defined(__x86_64__) || defined(_WIN64)
|
||||
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
|
||||
/* We will only enable nanboxing by default on 64 bit systems
|
||||
* on x86. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. */
|
||||
* for x64 and risc-v. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. Many arches allow/require this, but not all,
|
||||
* and it requires cooperation from the OS. ARM should also work in many configurations. */
|
||||
#define JANET_NANBOX_64
|
||||
#endif
|
||||
#endif
|
||||
@@ -333,7 +357,7 @@ typedef struct JanetOSRWLock JanetOSRWLock;
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "%s:%d - janet out of memory\n", __FILE__, __LINE__); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
#ifdef JANET_BSD
|
||||
@@ -425,6 +449,7 @@ typedef struct JanetReg JanetReg;
|
||||
typedef struct JanetRegExt JanetRegExt;
|
||||
typedef struct JanetMethod JanetMethod;
|
||||
typedef struct JanetSourceMapping JanetSourceMapping;
|
||||
typedef struct JanetSymbolMap JanetSymbolMap;
|
||||
typedef struct JanetView JanetView;
|
||||
typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
@@ -980,6 +1005,7 @@ struct JanetAbstractHead {
|
||||
/* Some function definition flags */
|
||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||
#define JANET_FUNCDEF_FLAG_HASSYMBOLMAP 0x40000
|
||||
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||
@@ -995,6 +1021,14 @@ struct JanetSourceMapping {
|
||||
int32_t column;
|
||||
};
|
||||
|
||||
/* Symbol to slot mapping & lifetime structure. */
|
||||
struct JanetSymbolMap {
|
||||
uint32_t birth_pc;
|
||||
uint32_t death_pc;
|
||||
uint32_t slot_index;
|
||||
const uint8_t *symbol;
|
||||
};
|
||||
|
||||
/* A function definition. Contains information needed to instantiate closures. */
|
||||
struct JanetFuncDef {
|
||||
JanetGCObject gc;
|
||||
@@ -1008,6 +1042,7 @@ struct JanetFuncDef {
|
||||
JanetSourceMapping *sourcemap;
|
||||
JanetString source;
|
||||
JanetString name;
|
||||
JanetSymbolMap *symbolmap;
|
||||
|
||||
int32_t flags;
|
||||
int32_t slotcount; /* The amount of stack space required for the function */
|
||||
@@ -1018,6 +1053,7 @@ struct JanetFuncDef {
|
||||
int32_t bytecode_length;
|
||||
int32_t environments_length;
|
||||
int32_t defs_length;
|
||||
int32_t symbolmap_length;
|
||||
};
|
||||
|
||||
/* A function environment */
|
||||
@@ -1093,6 +1129,8 @@ struct JanetAbstractType {
|
||||
int32_t (*hash)(void *p, size_t len);
|
||||
Janet(*next)(void *p, Janet key);
|
||||
Janet(*call)(void *p, int32_t argc, Janet *argv);
|
||||
size_t (*length)(void *p, size_t len);
|
||||
JanetByteView(*bytes)(void *p, size_t len);
|
||||
};
|
||||
|
||||
/* Some macros to let us add extra types to JanetAbstract types without
|
||||
@@ -1110,7 +1148,9 @@ struct JanetAbstractType {
|
||||
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
|
||||
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
|
||||
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH
|
||||
#define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES
|
||||
#define JANET_ATEND_BYTES
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
@@ -1545,8 +1585,10 @@ JANET_API Janet janet_array_pop(JanetArray *array);
|
||||
JANET_API Janet janet_array_peek(JanetArray *array);
|
||||
|
||||
/* Buffer functions */
|
||||
#define JANET_BUFFER_FLAG_NO_REALLOC 0x10000
|
||||
JANET_API JanetBuffer *janet_buffer(int32_t capacity);
|
||||
JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
|
||||
JANET_API JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count);
|
||||
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
|
||||
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
|
||||
@@ -1671,6 +1713,7 @@ JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
||||
|
||||
/* Marshaling */
|
||||
#define JANET_MARSHAL_UNSAFE 0x20000
|
||||
#define JANET_MARSHAL_NO_CYCLES 0x40000
|
||||
|
||||
JANET_API void janet_marshal(
|
||||
JanetBuffer *buf,
|
||||
@@ -1758,6 +1801,24 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
|
||||
|
||||
/* Sandboxing API */
|
||||
#define JANET_SANDBOX_SANDBOX 1
|
||||
#define JANET_SANDBOX_SUBPROCESS 2
|
||||
#define JANET_SANDBOX_NET_CONNECT 4
|
||||
#define JANET_SANDBOX_NET_LISTEN 8
|
||||
#define JANET_SANDBOX_FFI 16
|
||||
#define JANET_SANDBOX_FS_WRITE 32
|
||||
#define JANET_SANDBOX_FS_READ 64
|
||||
#define JANET_SANDBOX_HRTIME 128
|
||||
#define JANET_SANDBOX_ENV 256
|
||||
#define JANET_SANDBOX_DYNAMIC_MODULES 512
|
||||
#define JANET_SANDBOX_FS_TEMP 1024
|
||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||
#define JANET_SANDBOX_ALL (UINT32_MAX)
|
||||
JANET_API void janet_sandbox(uint32_t flags);
|
||||
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
|
||||
|
||||
/* Scratch Memory API */
|
||||
typedef void (*JanetScratchFinalizer)(void *);
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -33,6 +33,9 @@
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_INPUT
|
||||
#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
@@ -87,8 +90,30 @@ static void simpleline(JanetBuffer *buffer) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Windows */
|
||||
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
|
||||
/* State */
|
||||
|
||||
#ifndef JANET_SIMPLE_GETLINE
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
#endif
|
||||
|
||||
/* Fallback */
|
||||
#if defined(JANET_SIMPLE_GETLINE)
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
@@ -105,6 +130,80 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
simpleline(buffer);
|
||||
}
|
||||
|
||||
/* Rich implementation */
|
||||
#else
|
||||
|
||||
/* Windows */
|
||||
#ifdef _WIN32
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <io.h>
|
||||
|
||||
static void setup_console_output(void) {
|
||||
/* Enable color console on windows 10 console and utf8 output and other processing */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
if (gbl_israwmode) return 0;
|
||||
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode &= ~ENABLE_LINE_INPUT;
|
||||
dwMode &= ~ENABLE_INSERT_MODE;
|
||||
dwMode &= ~ENABLE_ECHO_INPUT;
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
||||
if (!SetConsoleMode(hOut, dwMode)) return 1;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode(void) {
|
||||
if (!gbl_israwmode) return;
|
||||
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_LINE_INPUT;
|
||||
dwMode |= ENABLE_INSERT_MODE;
|
||||
dwMode |= ENABLE_ECHO_INPUT;
|
||||
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode |= ENABLE_PROCESSED_INPUT;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static long write_console(const char *bytes, size_t n) {
|
||||
DWORD nwritten = 0;
|
||||
BOOL result = WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), bytes, (DWORD) n, &nwritten, NULL);
|
||||
if (!result) return -1; /* error */
|
||||
return (long)nwritten;
|
||||
}
|
||||
|
||||
static long read_console(char *into, size_t n) {
|
||||
DWORD numread;
|
||||
BOOL result = ReadConsole(GetStdHandle(STD_INPUT_HANDLE), into, (DWORD) n, &numread, NULL);
|
||||
if (!result) return -1; /* error */
|
||||
return (long)numread;
|
||||
}
|
||||
|
||||
static int check_simpleline(JanetBuffer *buffer) {
|
||||
if (!_isatty(_fileno(stdin)) || rawmode()) {
|
||||
simpleline(buffer);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Posix */
|
||||
#else
|
||||
|
||||
@@ -125,24 +224,7 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
#include <string.h>
|
||||
#include <signal.h>
|
||||
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -152,15 +234,6 @@ static const char *badterms[] = {
|
||||
NULL
|
||||
};
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = janet_malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
return memcpy(mem, s, len);
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
struct termios t;
|
||||
@@ -186,13 +259,54 @@ static void norawmode(void) {
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
const char *t = getenv("TERM");
|
||||
int i;
|
||||
if (!t) return 1;
|
||||
for (i = 0; badterms[i]; i++)
|
||||
if (!strcmp(t, badterms[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static long write_console(char *bytes, size_t n) {
|
||||
return write(STDOUT_FILENO, bytes, n);
|
||||
}
|
||||
|
||||
static long read_console(char *into, size_t n) {
|
||||
return read(STDIN_FILENO, into, n);
|
||||
}
|
||||
|
||||
static int check_simpleline(JanetBuffer *buffer) {
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return 1;
|
||||
}
|
||||
if (rawmode()) {
|
||||
simpleline(buffer);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = janet_malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
return memcpy(mem, s, len);
|
||||
}
|
||||
|
||||
#ifndef _WIN32
|
||||
static int curpos(void) {
|
||||
char buf[32];
|
||||
int cols, rows;
|
||||
unsigned int i = 0;
|
||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
||||
if (write_console("\x1b[6n", 4) != 4) return -1;
|
||||
while (i < sizeof(buf) - 1) {
|
||||
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
||||
if (read_console(buf + i, 1) != 1) break;
|
||||
if (buf[i] == 'R') break;
|
||||
i++;
|
||||
}
|
||||
@@ -201,20 +315,26 @@ static int curpos(void) {
|
||||
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
|
||||
return cols;
|
||||
}
|
||||
#endif
|
||||
|
||||
static int getcols(void) {
|
||||
#ifdef _WIN32
|
||||
CONSOLE_SCREEN_BUFFER_INFO csbi;
|
||||
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
|
||||
return (int)(csbi.srWindow.Right - csbi.srWindow.Left + 1);
|
||||
#else
|
||||
struct winsize ws;
|
||||
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
|
||||
int start, cols;
|
||||
start = curpos();
|
||||
if (start == -1) goto failed;
|
||||
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
|
||||
if (write_console("\x1b[999C", 6) != 6) goto failed;
|
||||
cols = curpos();
|
||||
if (cols == -1) goto failed;
|
||||
if (cols > start) {
|
||||
char seq[32];
|
||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
||||
if (write_console(seq, strlen(seq)) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
@@ -224,10 +344,11 @@ static int getcols(void) {
|
||||
}
|
||||
failed:
|
||||
return 80;
|
||||
#endif
|
||||
}
|
||||
|
||||
static void clear(void) {
|
||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
||||
if (write_console("\x1b[H\x1b[2J", 7) <= 0) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
@@ -259,7 +380,7 @@ static void refresh(void) {
|
||||
/* Move cursor to original position. */
|
||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
||||
janet_buffer_push_cstring(&b, seq);
|
||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
||||
if (write_console((char *) b.data, b.count) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
janet_buffer_deinit(&b);
|
||||
@@ -285,7 +406,7 @@ static int insert(char c, int draw) {
|
||||
if (gbl_plen + gbl_len < gbl_cols) {
|
||||
/* Avoid a full update of the line in the
|
||||
* trivial case. */
|
||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
||||
if (write_console(&c, 1) == -1) return -1;
|
||||
} else {
|
||||
refresh();
|
||||
}
|
||||
@@ -312,7 +433,7 @@ static void historymove(int delta) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
}
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
gbl_pos = gbl_len = (int) strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
@@ -527,6 +648,7 @@ static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "unquote");
|
||||
check_cmatch(src, "var");
|
||||
check_cmatch(src, "while");
|
||||
check_cmatch(src, "upscope");
|
||||
}
|
||||
|
||||
static void resolve_format(JanetTable *entry) {
|
||||
@@ -740,14 +862,14 @@ static int line() {
|
||||
|
||||
addhistory();
|
||||
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
char seq[3];
|
||||
|
||||
int rc;
|
||||
do {
|
||||
rc = read(STDIN_FILENO, &c, 1);
|
||||
rc = read_console(&c, 1);
|
||||
} while (rc < 0 && errno == EINTR);
|
||||
if (rc <= 0) return -1;
|
||||
|
||||
@@ -764,8 +886,13 @@ static int line() {
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
clearlines();
|
||||
norawmode();
|
||||
#ifdef _WIN32
|
||||
ExitProcess(1);
|
||||
#else
|
||||
kill(getpid(), SIGINT);
|
||||
#endif
|
||||
/* fallthrough */
|
||||
case 17: /* ctrl-q */
|
||||
gbl_cancel_current_repl_form = 1;
|
||||
@@ -826,23 +953,26 @@ static int line() {
|
||||
case 23: /* ctrl-w */
|
||||
kbackspacew();
|
||||
break;
|
||||
#ifndef _WIN32
|
||||
case 26: /* ctrl-z */
|
||||
clearlines();
|
||||
norawmode();
|
||||
kill(getpid(), SIGSTOP);
|
||||
rawmode();
|
||||
refresh();
|
||||
break;
|
||||
#endif
|
||||
case 27: /* escape sequence */
|
||||
/* Read the next two bytes representing the escape sequence.
|
||||
* Use two calls to handle slow terminals returning the two
|
||||
* chars at different times. */
|
||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||
if (read_console(seq, 1) == -1) break;
|
||||
/* Esc[ = Control Sequence Introducer (CSI) */
|
||||
if (seq[0] == '[') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (read_console(seq + 1, 1) == -1) break;
|
||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||
/* Extended escape, read additional byte. */
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (read_console(seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '1': /* Home */
|
||||
@@ -861,7 +991,7 @@ static int line() {
|
||||
}
|
||||
}
|
||||
} else if (seq[0] == 'O') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (read_console(seq + 1, 1) == -1) break;
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
@@ -944,28 +1074,12 @@ void janet_line_deinit() {
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
const char *t = getenv("TERM");
|
||||
int i;
|
||||
if (!t) return 1;
|
||||
for (i = 0; badterms[i]; i++)
|
||||
if (!strcmp(t, badterms[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
if (check_simpleline(buffer)) return;
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (rawmode()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
fputc('\n', out);
|
||||
@@ -981,6 +1095,13 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
replacehistory();
|
||||
}
|
||||
|
||||
static void clear_at_exit(void) {
|
||||
if (!gbl_israwmode) {
|
||||
clearlines();
|
||||
norawmode();
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -993,18 +1114,11 @@ int main(int argc, char **argv) {
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
setup_console_output();
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
|
||||
/* Try and not leave the terminal in a bad state */
|
||||
atexit(norawmode);
|
||||
#if !defined(JANET_SIMPLE_GETLINE)
|
||||
atexit(clear_at_exit);
|
||||
#endif
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -228,7 +228,7 @@
|
||||
|
||||
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
||||
(def myfun (juxt + - * /))
|
||||
(assert (= '[2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
|
||||
# Case statements
|
||||
(assert
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -41,10 +41,10 @@
|
||||
|
||||
# Looping idea
|
||||
(def xs
|
||||
(seq [x :in '[-1 0 1] y :in '[-1 0 1] :when (not= x y 0)] (tuple x y)))
|
||||
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
|
||||
(def txs (apply tuple xs))
|
||||
|
||||
(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
|
||||
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
|
||||
|
||||
# Generators
|
||||
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -294,9 +294,12 @@
|
||||
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
|
||||
|
||||
(with [f (file/temp)]
|
||||
(assert (= 0 (file/tell f)) "start of file")
|
||||
(file/write f "foo\n")
|
||||
(assert (= 4 (file/tell f)) "after written string")
|
||||
(file/flush f)
|
||||
(file/seek f :set 0)
|
||||
(assert (= 0 (file/tell f)) "start of file again")
|
||||
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
|
||||
|
||||
(var counter 0)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -265,4 +265,15 @@
|
||||
(ev/do-thread
|
||||
(assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
|
||||
|
||||
# marshal channels
|
||||
|
||||
(def ch (ev/chan 10))
|
||||
(ev/give ch "hello")
|
||||
(ev/give ch "world")
|
||||
(def ch2 (-> ch marshal unmarshal))
|
||||
(def item1 (ev/take ch2))
|
||||
(def item2 (ev/take ch2))
|
||||
(assert (= item1 "hello"))
|
||||
(assert (= item2 "world"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -144,7 +144,7 @@
|
||||
(assert (< 1000 1e23) "greater than immediate 2")
|
||||
|
||||
# os/execute with environment variables
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe (merge (os/environ) {"HELLO" "WORLD"}))) "os/execute with env")
|
||||
|
||||
# Regression #638
|
||||
(compwhen
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2022 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -93,5 +93,16 @@
|
||||
|
||||
(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
|
||||
|
||||
(end-suite)
|
||||
(let [b @""]
|
||||
(defn dummy [a b c]
|
||||
(+ a b c))
|
||||
(trace dummy)
|
||||
(defn errout [arg]
|
||||
(buffer/push b arg))
|
||||
(assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
|
||||
(assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
|
||||
|
||||
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
|
||||
(assert (= ((f 10) 37) 47) "asm environment tables")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2022 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -33,6 +33,7 @@
|
||||
# FFI check
|
||||
(compwhen has-ffi
|
||||
(ffi/context))
|
||||
|
||||
(compwhen has-ffi
|
||||
(ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
|
||||
(compwhen has-ffi
|
||||
|
||||
43
test/suite0013.janet
Normal file
43
test/suite0013.janet
Normal file
@@ -0,0 +1,43 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 13)
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
||||
@{0 0 1 3 2 6}))
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i)
|
||||
@{}))
|
||||
|
||||
(def- sym-prefix-peg
|
||||
(peg/compile
|
||||
~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:<?=>@^_"))
|
||||
:anchor (drop (cmt ($) ,|(= $ 0)))
|
||||
:cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
|
||||
:recur (+ :cap (> -1 :recur))
|
||||
:main (> -1 :recur)}))
|
||||
|
||||
(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback")
|
||||
(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2")
|
||||
|
||||
(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1")
|
||||
|
||||
(end-suite)
|
||||
20
test/suite0014.janet
Normal file
20
test/suite0014.janet
Normal file
@@ -0,0 +1,20 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 14)
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||
@[]) "peg not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||
@[]) "peg if-not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if-not drop")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
|
||||
(end-suite)
|
||||
48
test/suite0015.janet
Normal file
48
test/suite0015.janet
Normal file
@@ -0,0 +1,48 @@
|
||||
# test *debug* flags
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 15)
|
||||
|
||||
(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
|
||||
@[[0 3 0 'a] [1 3 1 'x]])
|
||||
"symbolslots when *debug* is true")
|
||||
|
||||
(defn a [arg]
|
||||
(def x 10)
|
||||
(do
|
||||
(def y 20)
|
||||
(def z 30)
|
||||
(+ x y z)))
|
||||
(def symbolslots (in (disasm a) :symbolslots))
|
||||
(def f (asm (disasm a)))
|
||||
(assert (deep= (in (disasm f) :symbolslots)
|
||||
symbolslots)
|
||||
"symbolslots survive disasm/asm")
|
||||
|
||||
(comment
|
||||
(setdyn *debug* true)
|
||||
(setdyn :pretty-format "%.40M")
|
||||
(def f (fn [x] (fn [y] (+ x y))))
|
||||
(assert (deep= (map last (in (disasm (f 10)) :symbolmap))
|
||||
@['x 'y])
|
||||
"symbolslots upvalues"))
|
||||
|
||||
(assert (deep= (in (disasm (defn a [arg]
|
||||
(def x 10)
|
||||
(do
|
||||
(def y 20)
|
||||
(def z 30)
|
||||
(+ x y z)))) :symbolmap)
|
||||
@[[0 7 0 'arg]
|
||||
[0 7 1 'a]
|
||||
[1 7 2 'x]
|
||||
[2 7 3 'y]
|
||||
[3 7 4 'z]])
|
||||
"arg & inner symbolslots")
|
||||
|
||||
# buffer/push-at
|
||||
(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456")) "buffer/push-at 1")
|
||||
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789")) "buffer/push-at 2")
|
||||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) "buffer/push-at 3")
|
||||
|
||||
(end-suite)
|
||||
Binary file not shown.
@@ -159,6 +159,7 @@
|
||||
<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_MANPATH_PERMACHINE" Name="JANET_MANPATH" Value="[DocsDir]" 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"/>
|
||||
@@ -167,6 +168,7 @@
|
||||
<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_MANPATH_PERUSER" Name="JANET_MANPATH" Value="[DocsDir]" 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"/>
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
Reference in New Issue
Block a user