mirror of
https://github.com/janet-lang/janet
synced 2026-04-06 23:11:25 +00:00
Compare commits
1 Commits
compile-op
...
undo-deep-
| Author | SHA1 | Date | |
|---|---|---|---|
|
5adfb75a25 |
@@ -1,4 +1,4 @@
|
||||
image: openbsd/7.6
|
||||
image: openbsd/7.4
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
|
||||
7
.github/workflows/codeql.yml
vendored
7
.github/workflows/codeql.yml
vendored
@@ -27,16 +27,15 @@ jobs:
|
||||
uses: actions/checkout@v3
|
||||
|
||||
- name: Initialize CodeQL
|
||||
uses: github/codeql-action/init@v3
|
||||
uses: github/codeql-action/init@v2
|
||||
with:
|
||||
languages: ${{ matrix.language }}
|
||||
queries: +security-and-quality
|
||||
tools: linked
|
||||
|
||||
- name: Autobuild
|
||||
uses: github/codeql-action/autobuild@v3
|
||||
uses: github/codeql-action/autobuild@v2
|
||||
|
||||
- name: Perform CodeQL Analysis
|
||||
uses: github/codeql-action/analyze@v3
|
||||
uses: github/codeql-action/analyze@v2
|
||||
with:
|
||||
category: "/language:${{ matrix.language }}"
|
||||
|
||||
12
.github/workflows/test.yml
vendored
12
.github/workflows/test.yml
vendored
@@ -25,7 +25,7 @@ jobs:
|
||||
name: Build and test on Windows
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ windows-latest, windows-2022 ]
|
||||
os: [ windows-latest, windows-2019 ]
|
||||
runs-on: ${{ matrix.os }}
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
@@ -46,7 +46,7 @@ jobs:
|
||||
name: Build and test on Windows Minimal build
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ windows-2022 ]
|
||||
os: [ windows-2019 ]
|
||||
runs-on: ${{ matrix.os }}
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
@@ -132,7 +132,7 @@ jobs:
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Enable qemu
|
||||
run: docker run --privileged --rm tonistiigi/binfmt --install s390x
|
||||
- name: Build and run on emulated architecture
|
||||
run: docker run --rm -v .:/janet --platform linux/s390x alpine sh -c "apk update && apk add --no-interactive git build-base && cd /janet && make -j3 && make test"
|
||||
- name: Do Qemu build and test
|
||||
run: |
|
||||
docker run --rm --privileged multiarch/qemu-user-static --reset -p yes
|
||||
docker run --rm -v .:/janet --platform linux/s390x ubuntu bash -c "apt-get -y update && apt-get -y install git build-essential && cd /janet && make -j3 && make test"
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -37,7 +37,6 @@ temp.janet
|
||||
temp.c
|
||||
temp*janet
|
||||
temp*.c
|
||||
temp.*
|
||||
scratch.janet
|
||||
scratch.c
|
||||
|
||||
|
||||
39
CHANGELOG.md
39
CHANGELOG.md
@@ -1,43 +1,12 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add `os/posix-chroot`
|
||||
- Fix `ev/deadline` with interrupt race condition bug on Windows.
|
||||
- Improve `flycheck` by allowing functions and macros to define their own flycheck behavior via the metadata `:flycheck`.
|
||||
- Add `*flychecking*` dynamic binding to check if inside flycheck evalutation
|
||||
- Add `gcperthread` callback for abstract types. This lets threaded abstracts have a finalizer that is called per thread, as well as a global finalizer.
|
||||
- Add `JANET_DO_ERROR_*` flags to describe the return value of `janet_dobytes` and `janet_dostring`.
|
||||
|
||||
## 1.39.1 - 2025-08-30
|
||||
- Add support for chdir in os/spawn on older macOS versions
|
||||
- Expose channels properly in C API
|
||||
|
||||
## 1.39.0 - 2025-08-24
|
||||
- Various bug fixes
|
||||
- Add `net/socket`
|
||||
- Add support for illumos OS
|
||||
- Raise helpful errors for incorrect arguments to `import`.
|
||||
- Allow configuring `JANET_THREAD_LOCAL` during builds to allow multi-threading on unknown compilers.
|
||||
- Make `ffi/write` append to a buffer instead of insert at 0 by default.
|
||||
- Add `os/getpid` to get the current process id.
|
||||
- Add `:out` option to `os/spawn` to be able to redirect stderr to stdout with pipes.
|
||||
Add `interrupt?` argument to `ev/deadline` to use VM interruptions.
|
||||
|
||||
## 1.38.0 - 2025-03-18
|
||||
- Add `bundle/replace`
|
||||
- Add CLI flags for the `bundle/` module to install and manage bundles.
|
||||
- Improve `?` peg special termination behavior
|
||||
- Add IEEE hex floats to grammar.
|
||||
- Add buffer peg literal support
|
||||
- Improve `split` peg special edge case behavior
|
||||
- Add Arm64 .msi support
|
||||
- Add `no-reuse` argument to `net/listen` to disable reusing server sockets
|
||||
- Add `struct/rawget`
|
||||
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys
|
||||
## ??? - Unreleased
|
||||
- Add `struct/rawget` to get values from a struct without a prototype.
|
||||
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys. Keys are now compared by value rather than
|
||||
structure to avoid degenerate cases.
|
||||
- Long strings will now dedent on `\r\n` instead of just `\n`.
|
||||
- Add `ev/to-file` for synchronous resource operations
|
||||
- Improve `file/open` error message by including path
|
||||
|
||||
## 1.37.1 - 2024-12-05
|
||||
- Fix meson cross compilation
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2025 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
|
||||
|
||||
39
Makefile
39
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
# Copyright (c) 2024 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
|
||||
@@ -47,18 +47,16 @@ SPORK_TAG?=master
|
||||
HAS_SHARED?=1
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
STRIPFLAGS=-x -S
|
||||
|
||||
# For cross compilation
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
# Symbols are (optionally) removed later, keep -g as default!
|
||||
CFLAGS?=-O0 -g
|
||||
CFLAGS?=-O2 -g
|
||||
LDFLAGS?=-rdynamic
|
||||
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
||||
LIBJANET_LDFLAGS?=$(LD_FLAGS)
|
||||
RUN:=$(RUN)
|
||||
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
@@ -81,12 +79,6 @@ ifeq ($(UNAME), Darwin)
|
||||
LDCONFIG:=true
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
else ifeq ($(UNAME), SunOS)
|
||||
BUILD_CFLAGS+=-D__EXTENSIONS__ -DJANET_NO_NANBOX
|
||||
BOOT_CFLAGS+=-D__EXTENSIONS__ -DJANET_NO_NANBOX
|
||||
CLIBS:=-lsocket -lm
|
||||
STRIPFLAGS=-x
|
||||
LDCONFIG:=false
|
||||
endif
|
||||
|
||||
# For other unix likes, add flags here!
|
||||
@@ -102,18 +94,12 @@ endif
|
||||
endif
|
||||
|
||||
# Mingw
|
||||
MINGW_COMPILER=
|
||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
MINGW_COMPILER=gcc
|
||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
||||
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
|
||||
JANET_TARGET:=$(JANET_TARGET).exe
|
||||
JANET_BOOT:=$(JANET_BOOT).exe
|
||||
COMPILER_VERSION:=$(shell $(CC) --version)
|
||||
ifeq ($(findstring clang,$(COMPILER_VERSION)), clang)
|
||||
MINGW_COMPILER=clang
|
||||
endif
|
||||
endif
|
||||
|
||||
|
||||
@@ -138,8 +124,7 @@ JANET_LOCAL_HEADERS=src/core/features.h \
|
||||
src/core/regalloc.h \
|
||||
src/core/compile.h \
|
||||
src/core/emit.h \
|
||||
src/core/symcache.h \
|
||||
src/core/sysir.h
|
||||
src/core/symcache.h
|
||||
|
||||
JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/array.c \
|
||||
@@ -174,9 +159,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/strtod.c \
|
||||
src/core/struct.c \
|
||||
src/core/symcache.c \
|
||||
src/core/sysir.c \
|
||||
src/core/sysir_c.c \
|
||||
src/core/sysir_x86.c \
|
||||
src/core/table.c \
|
||||
src/core/tuple.c \
|
||||
src/core/util.c \
|
||||
@@ -224,14 +206,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.40.dylib
|
||||
SONAME=libjanet.1.37.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.40
|
||||
endif
|
||||
|
||||
ifeq ($(MINGW_COMPILER), clang)
|
||||
SONAME=
|
||||
SONAME_SETTER=
|
||||
SONAME=libjanet.so.1.37
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
@@ -300,7 +277,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
README.md build/c/janet.c build/c/shell.c
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
strip $(STRIPFLAGS) 'build/$(JANET_DIST_DIR)/bin/janet'
|
||||
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
|
||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
||||
@@ -347,7 +324,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip $(STRIPFLAGS) '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
|
||||
21
README.md
21
README.md
@@ -165,21 +165,6 @@ make install-jpm-git
|
||||
|
||||
Find out more about the available make targets by running `make help`.
|
||||
|
||||
### Alpine Linux
|
||||
|
||||
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good combination. Janet can also
|
||||
be built inside a docker container or similar in this manner.
|
||||
|
||||
```sh
|
||||
docker run -it --rm alpine /bin/ash
|
||||
$ apk add make gcc musl-dev git
|
||||
$ git clone https://github.com/janet-lang/janet.git
|
||||
$ cd janet
|
||||
$ make -j10
|
||||
$ make test
|
||||
$ make install
|
||||
```
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
||||
@@ -213,10 +198,6 @@ gmake install-jpm-git
|
||||
NetBSD build instructions are the same as the FreeBSD build instructions.
|
||||
Alternatively, install the package directly with `pkgin install janet`.
|
||||
|
||||
### illumos
|
||||
|
||||
Building on illumos is exactly the same as building on FreeBSD.
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).
|
||||
@@ -226,7 +207,7 @@ Building on illumos is exactly the same as building on FreeBSD.
|
||||
|
||||
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
||||
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.14 Toolset](https://github.com/wixtoolset/wix3/releases).
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
|
||||
6. Run `build_win dist`.
|
||||
|
||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||
|
||||
@@ -20,11 +20,11 @@
|
||||
@setlocal
|
||||
|
||||
@rem Example use asan
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi /DEBUG
|
||||
@set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib /DEBUG
|
||||
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
|
||||
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
|
||||
|
||||
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||
@rem set JANET_LINK=link /nologo
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||
@set JANET_LINK=link /nologo
|
||||
|
||||
@set JANET_LINK_STATIC=lib /nologo
|
||||
|
||||
@@ -41,35 +41,34 @@ if not exist build\boot mkdir build\boot
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
)
|
||||
for %%f in (src\boot\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@rem note that there is no default sysroot being baked in
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
build\janet_boot . > build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build the sources
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build the resources
|
||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.lib)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
@@ -92,7 +91,7 @@ exit /b 0
|
||||
|
||||
@rem Clean build artifacts
|
||||
:CLEAN
|
||||
del *.exe *.lib *.exp *.msi *.wixpdb
|
||||
del *.exe *.lib *.exp
|
||||
rd /s /q build
|
||||
if exist dist (
|
||||
rd /s /q dist
|
||||
@@ -103,7 +102,7 @@ exit /b 0
|
||||
:TEST
|
||||
for %%f in (test/suite*.janet) do (
|
||||
janet.exe test\%%f
|
||||
@if errorlevel 1 goto TESTFAIL
|
||||
@if not errorlevel 0 goto TESTFAIL
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@@ -144,13 +143,7 @@ if defined CI (
|
||||
) else (
|
||||
set WIXBIN=
|
||||
)
|
||||
|
||||
set WIXARCH=%BUILDARCH%
|
||||
if "%WIXARCH%"=="aarch64" (
|
||||
set WIXARCH=arm64
|
||||
)
|
||||
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %WIXARCH% -out build\
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
|
||||
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
|
||||
exit /b 0
|
||||
|
||||
|
||||
@@ -1,6 +0,0 @@
|
||||
# Linux only - uses abstract unix domain sockets
|
||||
(ev/spawn (net/server :unix "@abc123" (fn [conn] (print (:read conn 1024)) (:close conn))))
|
||||
(ev/sleep 1)
|
||||
(def s (net/connect :unix "@abc123" :stream))
|
||||
(:write s "hello")
|
||||
(:close s)
|
||||
@@ -1,4 +1,4 @@
|
||||
@{
|
||||
:name "sample-dep1"
|
||||
:dependencies [{:name "sample-dep2"}]
|
||||
:dependencies ["sample-dep2"]
|
||||
}
|
||||
|
||||
@@ -1,71 +0,0 @@
|
||||
###
|
||||
### Create a .bmp file on linux.
|
||||
###
|
||||
|
||||
# Quick run and view on Linux:
|
||||
# build/janet examples/sysir/drawing.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
|
||||
|
||||
(use ./frontend)
|
||||
|
||||
(defn-external write:void [fd:int mem:pointer size:uint])
|
||||
(defn-external exit:void [x:int])
|
||||
|
||||
# assume 128x128 32 bit color image
|
||||
# Size : 128 * 128 * 4 + align(14 + 40, 4) = 65592
|
||||
# dib offset : align(14 + 40, 4) = 56
|
||||
|
||||
(defsys write_32:void [x:uint]
|
||||
(write 1 (address x) 4)
|
||||
(return))
|
||||
|
||||
(defsys write_16:void [x:uint]
|
||||
(write 1 (address x) 2)
|
||||
(return))
|
||||
|
||||
(defsys write_header:void [w:uint h:uint]
|
||||
(write 1 "BM" 2)
|
||||
(def size:uint (+ 56 (* w h 4)))
|
||||
(write_32 size)
|
||||
(write_32 0)
|
||||
(write_32 56) # pixel array offset
|
||||
# Begin DIB
|
||||
(write_32 40) # dib size
|
||||
(write_32 w)
|
||||
(write_32 h)
|
||||
(write_16 1) # color panes - must be 1
|
||||
(write_16 32) # bits per pixel
|
||||
(write_32 0) # compression method - no compression
|
||||
(write_32 0) # image size - not needed when no compression, 0 should be fine
|
||||
(write_32 4096) # pixels per meter - horizontal resolution
|
||||
(write_32 4096) # pixels per meter - vertical resolution
|
||||
(write_32 0) # number of colors in palette - no palette so 0
|
||||
(write_32 0) # number of "important colors" ignored in practice
|
||||
(write_16 0) # add "gap 1" to align pixel array to multiple of 4 bytes
|
||||
(return))
|
||||
|
||||
(defsys draw:void [w:uint h:uint]
|
||||
(def red:uint 0xFFFF0000)
|
||||
(def blue:uint 0xFF0000FF)
|
||||
(def size:uint (* w h 4))
|
||||
(var y:uint 0)
|
||||
(while (< y h)
|
||||
(var x:uint 0)
|
||||
(while (< x w)
|
||||
(write_32 (if (> y 64) blue red))
|
||||
(set x (+ 1 x)))
|
||||
(set y (+ y 1)))
|
||||
(return))
|
||||
|
||||
(defsys main:int []
|
||||
(def w:uint 512)
|
||||
(def h:uint 512)
|
||||
(write_header w h)
|
||||
(draw w h)
|
||||
(return 0))
|
||||
|
||||
####
|
||||
|
||||
#(dump)
|
||||
(print "#include <unistd.h>")
|
||||
(dumpc)
|
||||
#(dumpx64)
|
||||
@@ -1,86 +0,0 @@
|
||||
###
|
||||
### Create a .bmp file on linux.
|
||||
###
|
||||
|
||||
# Quick run and view on Linux:
|
||||
# build/janet examples/sysir/drawing2.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
|
||||
|
||||
(use ./frontend)
|
||||
|
||||
(setdyn :verbose true)
|
||||
|
||||
# Pointer types
|
||||
(defpointer p32 uint)
|
||||
(defpointer p16 u16)
|
||||
(defpointer cursor p32)
|
||||
|
||||
# External
|
||||
(defn-external write:void [fd:int mem:pointer size:uint])
|
||||
(defn-external exit:void [x:int])
|
||||
(defn-external malloc:p32 [size:uint])
|
||||
|
||||
(defsys w32:void [c:cursor x:uint]
|
||||
(def p:p32 (load c))
|
||||
(store p x)
|
||||
(store c (the p32 (pointer-add p 1)))
|
||||
(return))
|
||||
|
||||
(defsys w16:void [c:cursor x:uint]
|
||||
# Casting needs revisiting
|
||||
(def p:p16 (cast (the p32 (load c))))
|
||||
(store p (the u16 (cast x)))
|
||||
(store c (the p32 (cast (the p16 (pointer-add p 1)))))
|
||||
(return))
|
||||
|
||||
(defsys makebmp:p32 [w:uint h:uint]
|
||||
(def size:uint (+ 56 (* w h 4)))
|
||||
(def mem:p32 (malloc size))
|
||||
(def c:cursor (cast (malloc 4)))
|
||||
#(def cursor_data:p32 mem)
|
||||
#(def c:cursor (address cursor_data))
|
||||
(store c mem)
|
||||
(w16 c 0x4D42) # ascii "BM"
|
||||
(w32 c size)
|
||||
(w32 c 0)
|
||||
(w32 c 56)
|
||||
(w32 c 40)
|
||||
(w32 c w)
|
||||
(w32 c h)
|
||||
(w16 c 1)
|
||||
(w16 c 32)
|
||||
(w32 c 0)
|
||||
(w32 c 0)
|
||||
(w32 c 4096)
|
||||
(w32 c 4096)
|
||||
(w32 c 0)
|
||||
(w32 c 0)
|
||||
(w16 c 0) # padding
|
||||
# Draw
|
||||
(def red:uint 0xFFFF0000)
|
||||
(def blue:uint 0xFF0000FF)
|
||||
(def green:uint 0xFF00FF00)
|
||||
(var y:uint 0)
|
||||
(while (< y h)
|
||||
(var x:uint 0)
|
||||
(while (< x w)
|
||||
(def d2:uint (+ (* x x) (* y y)))
|
||||
(if (> d2 100000)
|
||||
(if (> d2 200000) (w32 c green) (w32 c blue))
|
||||
(w32 c red))
|
||||
(set x (+ 1 x)))
|
||||
(set y (+ y 1)))
|
||||
(write 1 mem size)
|
||||
(return mem))
|
||||
|
||||
(defsys main:int []
|
||||
(def w:uint 512)
|
||||
(def h:uint 512)
|
||||
(makebmp w h)
|
||||
(return 0))
|
||||
|
||||
####
|
||||
|
||||
(dumpx64)
|
||||
|
||||
#(print "#include <unistd.h>")
|
||||
#(dumpc)
|
||||
@@ -1,567 +0,0 @@
|
||||
# Make a language frontend for the sysir.
|
||||
# Dialect:
|
||||
# TODO -
|
||||
# * arrays (declaration, loads, stores)
|
||||
|
||||
(defdyn *ret-type* "Current function return type")
|
||||
|
||||
(def slot-to-name @[])
|
||||
(def name-to-slot @{})
|
||||
(def type-to-name @[])
|
||||
(def name-to-type @{})
|
||||
(def slot-types @{})
|
||||
(def functions @{})
|
||||
(def type-fields @{})
|
||||
(def syscalls @{})
|
||||
|
||||
(defn get-slot
|
||||
[&opt new-name]
|
||||
(def next-slot (length slot-to-name))
|
||||
(array/push slot-to-name new-name)
|
||||
(if new-name (put name-to-slot new-name next-slot))
|
||||
next-slot)
|
||||
|
||||
(defn named-slot
|
||||
[name]
|
||||
(assert (get name-to-slot name)))
|
||||
|
||||
(defn make-type
|
||||
[&opt new-name]
|
||||
(def next-type (length type-to-name))
|
||||
(array/push type-to-name new-name)
|
||||
(if new-name (put name-to-type new-name next-type))
|
||||
next-type)
|
||||
|
||||
(defn named-type
|
||||
[name]
|
||||
(def t (get name-to-type name))
|
||||
(assert t)
|
||||
t)
|
||||
|
||||
(defn binding-type
|
||||
[name]
|
||||
(def slot (assert (get name-to-slot name)))
|
||||
(assert (get slot-types slot)))
|
||||
|
||||
(defn slot-type
|
||||
[slot]
|
||||
(assert (get slot-types slot)))
|
||||
|
||||
(defn assign-type
|
||||
[name typ]
|
||||
(def slot (get name-to-slot name))
|
||||
(put slot-types slot typ))
|
||||
|
||||
(defn assign-slot-type
|
||||
[slot typ]
|
||||
(put slot-types slot typ))
|
||||
|
||||
(defn setup-default-types
|
||||
[ctx]
|
||||
(def into @[])
|
||||
(defn add-prim-type
|
||||
[name native-name]
|
||||
(array/push into ~(type-prim ,name ,native-name))
|
||||
(make-type name))
|
||||
(add-prim-type 'float 'f32)
|
||||
(add-prim-type 'double 'f64)
|
||||
(add-prim-type 'int 's32)
|
||||
(add-prim-type 'uint 'u32)
|
||||
(add-prim-type 'long 's64)
|
||||
(add-prim-type 'ulong 'u64)
|
||||
(add-prim-type 'boolean 'boolean)
|
||||
(add-prim-type 's16 's16)
|
||||
(add-prim-type 'u16 'u16)
|
||||
(add-prim-type 'byte 'u8)
|
||||
(add-prim-type 'void 'void)
|
||||
(array/push into ~(type-pointer pointer void))
|
||||
(make-type 'pointer)
|
||||
(sysir/asm ctx into)
|
||||
ctx)
|
||||
|
||||
(defn type-extract
|
||||
"Given a symbol:type combination, extract the proper name and the type separately"
|
||||
[combined-name &opt default-type]
|
||||
(def parts (string/split ":" combined-name 0 2))
|
||||
(def [name tp] parts)
|
||||
[(symbol name) (symbol (or tp default-type))])
|
||||
|
||||
(var do-binop nil)
|
||||
(var do-comp nil)
|
||||
|
||||
###
|
||||
### Inside functions
|
||||
###
|
||||
|
||||
(defn visit1
|
||||
"Take in a form and compile code and put it into `into`. Return result slot."
|
||||
[code into &opt no-return type-hint]
|
||||
(def subresult
|
||||
(cond
|
||||
|
||||
# Compile a constant
|
||||
(string? code) ~(pointer ,code)
|
||||
(boolean? code) ~(boolean ,code)
|
||||
(number? code) ~(,(or type-hint 'double) ,code) # TODO - should default to double
|
||||
|
||||
# Needed?
|
||||
(= :core/u64 (type code)) ~(ulong ,code)
|
||||
(= :core/s64 (type code)) ~(long ,code)
|
||||
|
||||
# Binding
|
||||
(symbol? code)
|
||||
(named-slot code)
|
||||
|
||||
# Array literals
|
||||
(and (tuple? code) (= :brackets (tuple/type code)))
|
||||
(do
|
||||
(assert type-hint (string/format "unknown type for array literal %v" code))
|
||||
~(,type-hint ,code))
|
||||
|
||||
# Compile forms
|
||||
(and (tuple? code) (= :parens (tuple/type code)))
|
||||
(do
|
||||
(assert (> (length code) 0))
|
||||
(def [op & args] code)
|
||||
(case op
|
||||
|
||||
# Arithmetic
|
||||
'+ (do-binop 'add args into type-hint)
|
||||
'- (do-binop 'subtract args into type-hint)
|
||||
'* (do-binop 'multiply args into type-hint)
|
||||
'/ (do-binop 'divide args into type-hint)
|
||||
'<< (do-binop 'shl args into type-hint)
|
||||
'>> (do-binop 'shr args into type-hint)
|
||||
|
||||
# Comparison
|
||||
'= (do-comp 'eq args into)
|
||||
'not= (do-comp 'neq args into)
|
||||
'< (do-comp 'lt args into)
|
||||
'<= (do-comp 'lte args into)
|
||||
'> (do-comp 'gt args into)
|
||||
'>= (do-comp 'gte args into)
|
||||
|
||||
# Pointers
|
||||
'pointer-add
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [base offset] args)
|
||||
(def base-slot (visit1 base into false type-hint))
|
||||
(def offset-slot (visit1 offset into false 'int))
|
||||
(def slot (get-slot))
|
||||
(when type-hint (array/push into ~(bind ,slot ,type-hint)))
|
||||
(array/push into ~(pointer-add ,slot ,base-slot ,offset-slot))
|
||||
slot)
|
||||
|
||||
'pointer-sub
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [base offset] args)
|
||||
(def base-slot (visit1 base into false type-hint))
|
||||
(def offset-slot (visit1 offset into false 'int))
|
||||
(def slot (get-slot))
|
||||
(when type-hint (array/push into ~(bind ,slot ,type-hint)))
|
||||
(array/push into ~(pointer-subtract ,slot ,base-slot ,offset-slot))
|
||||
slot)
|
||||
|
||||
# Type hinting
|
||||
'the
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [xtype x] args)
|
||||
(def result (visit1 x into false xtype))
|
||||
(if (tuple? result) # constant
|
||||
(let [[t y] result]
|
||||
(assertf (= t xtype) "type mismatch, %p doesn't match %p" t xtype)
|
||||
[xtype y])
|
||||
(do
|
||||
(array/push into ~(bind ,result ,xtype))
|
||||
result)))
|
||||
|
||||
# Casting
|
||||
'cast
|
||||
(do
|
||||
(assert (= 1 (length args)))
|
||||
(assert type-hint) # should we add an explicit cast type?
|
||||
(def [x] args)
|
||||
(def slot (get-slot))
|
||||
(def result (visit1 x into false))
|
||||
(array/push into ~(bind ,slot ,type-hint))
|
||||
(array/push into ~(cast ,slot ,result))
|
||||
slot)
|
||||
|
||||
# Named bindings
|
||||
'def
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [full-name value] args)
|
||||
(assert (symbol? full-name))
|
||||
(def [name tp] (type-extract full-name 'int))
|
||||
(def result (visit1 value into false tp))
|
||||
(def slot (get-slot name))
|
||||
(assign-type name tp)
|
||||
(array/push into ~(bind ,slot ,tp))
|
||||
(array/push into ~(move ,slot ,result))
|
||||
slot)
|
||||
|
||||
# Named variables
|
||||
'var
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [full-name value] args)
|
||||
(assert (symbol? full-name))
|
||||
(def [name tp] (type-extract full-name 'int))
|
||||
(def result (visit1 value into false tp))
|
||||
(def slot (get-slot name))
|
||||
(assign-type name tp)
|
||||
(array/push into ~(bind ,slot ,tp))
|
||||
(array/push into ~(move ,slot ,result))
|
||||
slot)
|
||||
|
||||
# Address of (& operator in C)
|
||||
'address
|
||||
(do
|
||||
(assert (= 1 (length args)))
|
||||
(def [thing] args)
|
||||
(def [name tp] (type-extract thing 'int))
|
||||
(def result (visit1 thing into false tp))
|
||||
(def slot (get-slot))
|
||||
#
|
||||
(array/push into ~(bind ,slot ,type-hint))
|
||||
(array/push into ~(address ,slot ,result))
|
||||
slot)
|
||||
|
||||
'load
|
||||
(do
|
||||
(assert (= 1 (length args)))
|
||||
(assert type-hint)
|
||||
(def [thing] args)
|
||||
# (def [name tp] (type-extract thing 'pointer))
|
||||
(def result (visit1 thing into false))
|
||||
(def slot (get-slot))
|
||||
(def ptype type-hint)
|
||||
(array/push into ~(bind ,slot ,ptype))
|
||||
(array/push into ~(load ,slot ,result))
|
||||
slot)
|
||||
|
||||
'store
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [dest value] args)
|
||||
# (def [name tp] (type-extract dest 'pointer))
|
||||
(def dest-r (visit1 dest into false))
|
||||
(def value-r (visit1 value into false))
|
||||
(array/push into ~(store ,dest-r ,value-r))
|
||||
value-r)
|
||||
|
||||
# Assignment
|
||||
'set
|
||||
(do
|
||||
(assert (= 2 (length args)))
|
||||
(def [to x] args)
|
||||
(def type-hint (binding-type to))
|
||||
(def result (visit1 x into false type-hint))
|
||||
(def toslot (named-slot to))
|
||||
(array/push into ~(move ,toslot ,result))
|
||||
toslot)
|
||||
|
||||
# Return
|
||||
'return
|
||||
(do
|
||||
(assert (>= 1 (length args)))
|
||||
(if (empty? args)
|
||||
(array/push into '(return))
|
||||
(do
|
||||
(def [x] args)
|
||||
(array/push into ~(return ,(visit1 x into false (dyn *ret-type*))))))
|
||||
nil)
|
||||
|
||||
# Sequence of operations
|
||||
'do
|
||||
(do
|
||||
(each form (slice args 0 -2) (visit1 form into true))
|
||||
(visit1 (last args) into false type-hint))
|
||||
|
||||
# While loop
|
||||
'while
|
||||
(do
|
||||
(def lab-test (keyword (gensym)))
|
||||
(def lab-exit (keyword (gensym)))
|
||||
(assert (< 1 (length args)))
|
||||
(def [cnd & body] args)
|
||||
(array/push into lab-test)
|
||||
(def condition-slot (visit1 cnd into false 'boolean))
|
||||
(array/push into ~(branch-not ,condition-slot ,lab-exit))
|
||||
(each code body
|
||||
(visit1 code into true))
|
||||
(array/push into ~(jump ,lab-test))
|
||||
(array/push into lab-exit)
|
||||
nil)
|
||||
|
||||
# Branch
|
||||
'if
|
||||
(do
|
||||
(def lab (keyword (gensym)))
|
||||
(def lab-end (keyword (gensym)))
|
||||
(assert (< 2 (length args) 4))
|
||||
(def [cnd tru fal] args)
|
||||
(def condition-slot (visit1 cnd into false 'boolean))
|
||||
(def ret (if type-hint (get-slot)))
|
||||
(when type-hint (array/push into ~(bind ,ret ,type-hint)))
|
||||
(array/push into ~(branch ,condition-slot ,lab))
|
||||
# false path
|
||||
(if type-hint
|
||||
(array/push into ~(move ,ret ,(visit1 fal into false type-hint)))
|
||||
(visit1 fal into true))
|
||||
(array/push into ~(jump ,lab-end))
|
||||
(array/push into lab)
|
||||
# true path
|
||||
(if type-hint
|
||||
(array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
|
||||
(visit1 tru into true))
|
||||
(array/push into lab-end)
|
||||
ret)
|
||||
|
||||
# Insert IR
|
||||
'ir
|
||||
(do
|
||||
(assert no-return)
|
||||
(array/push into ;args)
|
||||
nil)
|
||||
|
||||
# Assume function call or syscall
|
||||
(do
|
||||
(def slots @[])
|
||||
(def signature (get functions op))
|
||||
(def is-syscall (get syscalls op))
|
||||
(assert signature (string "unknown function " op))
|
||||
(def ret (if no-return nil (get-slot)))
|
||||
(when ret
|
||||
(array/push into ~(bind ,ret ,(first signature)))
|
||||
(assign-type ret (first signature)))
|
||||
(each [arg-type arg] (map tuple (drop 1 signature) args)
|
||||
(array/push slots (visit1 arg into false arg-type)))
|
||||
(if is-syscall
|
||||
(array/push into ~(syscall :default ,ret (int ,is-syscall) ,;slots))
|
||||
(array/push into ~(call :default ,ret [pointer ,op] ,;slots)))
|
||||
ret)))
|
||||
|
||||
(errorf "cannot compile %q" code)))
|
||||
|
||||
# Check type-hint matches return type
|
||||
(if type-hint
|
||||
(when-let [t (first subresult)] # TODO - Disallow empty types
|
||||
(assert (= type-hint t) (string/format "%j, expected type %v, got %v" code type-hint t))))
|
||||
|
||||
subresult)
|
||||
|
||||
(varfn do-binop
|
||||
"Emit an operation such as (+ x y).
|
||||
Extended to support any number of arguments such as (+ x y z ...)"
|
||||
[opcode args into type-hint]
|
||||
(var typ type-hint)
|
||||
(var final nil)
|
||||
(def slots @[])
|
||||
(each arg args
|
||||
(def right (visit1 arg into false typ))
|
||||
(when (number? right) (array/push slots right))
|
||||
|
||||
# If we don't have a type hint, infer types from bottom up
|
||||
(when (nil? typ)
|
||||
(when-let [new-typ (get slot-types right)]
|
||||
(set typ new-typ)))
|
||||
|
||||
(set final
|
||||
(if final
|
||||
(let [result (get-slot)]
|
||||
(array/push slots result)
|
||||
(array/push into ~(,opcode ,result ,final ,right))
|
||||
result)
|
||||
right)))
|
||||
(assert typ (string "unable to infer type for %j" [opcode ;args]))
|
||||
(each slot (distinct slots)
|
||||
(array/push into ~(bind ,slot ,typ)))
|
||||
(assert final))
|
||||
|
||||
(varfn do-comp
|
||||
"Emit a comparison form such as (= x y z ...)"
|
||||
[opcode args into]
|
||||
(def result (get-slot))
|
||||
(def needs-temp (> 2 (length args)))
|
||||
(def temp-result (if needs-temp (get-slot) nil))
|
||||
(array/push into ~(bind ,result boolean))
|
||||
(when needs-temp
|
||||
(array/push into ~(bind ,temp-result boolean)))
|
||||
(var left nil)
|
||||
(var first-compare true)
|
||||
(var typ nil)
|
||||
(each arg args
|
||||
(def right (visit1 arg into false typ))
|
||||
# If we don't have a type hint, infer types from bottom up
|
||||
(when (nil? typ)
|
||||
(when-let [new-typ (get slot-types right)]
|
||||
(set typ new-typ)))
|
||||
(when left
|
||||
(if first-compare
|
||||
(array/push into ~(,opcode ,result ,left ,right))
|
||||
(do
|
||||
(array/push into ~(,opcode ,temp-result ,left ,right))
|
||||
(array/push into ~(and ,result ,temp-result ,result))))
|
||||
(set first-compare false))
|
||||
(set left right))
|
||||
result)
|
||||
|
||||
###
|
||||
### Top level
|
||||
###
|
||||
|
||||
(defn top
|
||||
"Visit and emit code for a top level form."
|
||||
[ctx form]
|
||||
(assert (tuple? form))
|
||||
(def [head & rest] form)
|
||||
(case head
|
||||
|
||||
# Declare a struct
|
||||
'defstruct
|
||||
(do
|
||||
(def into @[])
|
||||
(def [name & fields] rest)
|
||||
(assert (even? (length fields)) "expected an even number of fields for struct definition")
|
||||
(def field-types @[])
|
||||
(each [field-name typ] (partition 2 fields)
|
||||
# TODO - don't ignore field names
|
||||
(array/push field-types typ))
|
||||
(array/push into ~(type-struct ,name ,;field-types))
|
||||
# (eprintf "%.99M" into)
|
||||
(sysir/asm ctx into))
|
||||
|
||||
# Declare a union
|
||||
'defunion
|
||||
(do
|
||||
(def into @[])
|
||||
(def [name & fields] rest)
|
||||
(assert (even? (length fields)) "expected an even number of fields for struct definition")
|
||||
(def field-types @[])
|
||||
(each [field-name typ] (partition 2 fields)
|
||||
# TODO - don't ignore field names
|
||||
(array/push field-types typ))
|
||||
(array/push into ~(type-union ,name ,;field-types))
|
||||
# (eprintf "%.99M" into)
|
||||
(sysir/asm ctx into))
|
||||
|
||||
# Declare a pointer type
|
||||
'defpointer
|
||||
(do
|
||||
(def into @[])
|
||||
(def [name element] rest)
|
||||
(def field-types @[])
|
||||
(array/push into ~(type-pointer ,name ,element))
|
||||
# (eprintf "%.99M" into)
|
||||
(sysir/asm ctx into))
|
||||
|
||||
# Declare an array type
|
||||
'defarray
|
||||
(do
|
||||
(def into @[])
|
||||
(def [name element cnt] rest)
|
||||
(assert (and (pos? cnt) (int? cnt)) "expected positive integer for array count")
|
||||
(array/push into ~(type-array ,name ,element ,cnt))
|
||||
# (eprintf "%.99M" into)
|
||||
(sysir/asm ctx into))
|
||||
|
||||
# External function
|
||||
'defn-external
|
||||
(do
|
||||
(def [name args] rest)
|
||||
(assert (tuple? args))
|
||||
(def [fn-name fn-tp] (type-extract name 'void))
|
||||
(def pcount (length args)) #TODO - more complicated signatures
|
||||
(def signature @[fn-tp])
|
||||
(each arg args
|
||||
(def [name tp] (type-extract arg 'int))
|
||||
(array/push signature tp))
|
||||
(put functions fn-name (freeze signature)))
|
||||
|
||||
# External syscall
|
||||
'defn-syscall
|
||||
(do
|
||||
(def [name sysnum args] rest)
|
||||
(assert (tuple? args))
|
||||
(def [fn-name fn-tp] (type-extract name 'void))
|
||||
(def pcount (length args)) #TODO - more complicated signatures
|
||||
(def signature @[fn-tp])
|
||||
(each arg args
|
||||
(def [name tp] (type-extract arg 'int))
|
||||
(array/push signature tp))
|
||||
(put syscalls fn-name sysnum)
|
||||
(put functions fn-name (freeze signature)))
|
||||
|
||||
# Top level function definition
|
||||
'defn
|
||||
(do
|
||||
# TODO doc strings
|
||||
(table/clear name-to-slot)
|
||||
(table/clear slot-types)
|
||||
(array/clear slot-to-name)
|
||||
(def [name args & body] rest)
|
||||
(assert (tuple? args))
|
||||
(def [fn-name fn-tp] (type-extract name 'void))
|
||||
(def pcount (length args)) #TODO - more complicated signatures
|
||||
(def ir-asm
|
||||
@[~(link-name ,(string fn-name))
|
||||
~(parameter-count ,pcount)])
|
||||
(def signature @[fn-tp])
|
||||
(each arg args
|
||||
(def [name tp] (type-extract arg 'int))
|
||||
(def slot (get-slot name))
|
||||
(assign-type name tp)
|
||||
(array/push signature tp)
|
||||
(array/push ir-asm ~(bind ,slot ,tp)))
|
||||
(with-dyns [*ret-type* fn-tp]
|
||||
(each part body
|
||||
(visit1 part ir-asm true)))
|
||||
(put functions fn-name (freeze signature))
|
||||
(when (dyn :verbose) (eprintf "%.99M" ir-asm))
|
||||
(sysir/asm ctx ir-asm))
|
||||
|
||||
(errorf "unknown form %p" form)))
|
||||
|
||||
###
|
||||
### Setup
|
||||
###
|
||||
|
||||
(def ctx (sysir/context))
|
||||
(setup-default-types ctx)
|
||||
|
||||
(defn compile1
|
||||
[x]
|
||||
(top ctx x))
|
||||
|
||||
(defn dump
|
||||
[]
|
||||
(eprintf "%.99M\n" (sysir/to-ir ctx)))
|
||||
|
||||
(defn dumpx64
|
||||
[]
|
||||
(print (sysir/to-x64 ctx)))
|
||||
|
||||
(defn dumpx64-windows
|
||||
[]
|
||||
(print (sysir/to-x64 ctx @"" :windows)))
|
||||
|
||||
(defn dumpc
|
||||
[]
|
||||
(print (sysir/to-c ctx)))
|
||||
|
||||
###
|
||||
### Top Level aliases
|
||||
###
|
||||
|
||||
(defmacro defstruct [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defstruct ,;args))])
|
||||
(defmacro defunion [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defunion ,;args))])
|
||||
(defmacro defarray [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defarray ,;args))])
|
||||
(defmacro defpointer [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defpointer ,;args))])
|
||||
(defmacro defn-external [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-external ,;args))])
|
||||
(defmacro defn-syscall [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-syscall ,;args))])
|
||||
(defmacro defsys [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn ,;args))])
|
||||
@@ -1,16 +0,0 @@
|
||||
(use ./frontend)
|
||||
|
||||
(defn-external printf:int [fmt:pointer])
|
||||
(defn-external exit:void [x:int])
|
||||
|
||||
(defsys _start:void []
|
||||
(printf "hello, world!\n")
|
||||
(exit (the int 0))
|
||||
(return))
|
||||
|
||||
(defn main [& args]
|
||||
(def [_ what] args)
|
||||
(eprint "MODE: " what)
|
||||
(case what
|
||||
"c" (dumpc)
|
||||
"x64" (dumpx64)))
|
||||
@@ -1,5 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
valgrind build/janet examples/sysir/drawing.janet > temp.c
|
||||
cc temp.c
|
||||
./a.out > temp.bmp
|
||||
feh temp.bmp
|
||||
@@ -1,5 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
valgrind build/janet examples/sysir/drawing2.janet > temp.nasm
|
||||
nasm -felf64 temp.nasm -l temp.lst -o temp.o
|
||||
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
|
||||
valgrind ./temp.bin
|
||||
@@ -1,4 +0,0 @@
|
||||
janet.exe examples/sysir/windows_samples.janet > temp.nasm
|
||||
nasm -fwin64 temp.nasm -l temp.lst -o temp.o
|
||||
link /entry:Start /subsystem:windows kernel32.lib user32.lib temp.o /out:temp.exe
|
||||
temp.exe
|
||||
@@ -1,5 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
valgrind build/janet examples/sysir/samples.janet > temp.nasm
|
||||
nasm -felf64 temp.nasm -l temp.lst -o temp.o
|
||||
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
|
||||
valgrind ./temp.bin
|
||||
@@ -1,72 +0,0 @@
|
||||
(use ./frontend)
|
||||
|
||||
(defstruct vec3
|
||||
a float
|
||||
b float
|
||||
c float)
|
||||
|
||||
(defunion myunion
|
||||
a float
|
||||
b double
|
||||
c long)
|
||||
|
||||
(defarray myvec float 4)
|
||||
(defarray mymat myvec 4)
|
||||
|
||||
(defn-external printf:int [fmt:pointer x:int]) # TODO varargs
|
||||
|
||||
(defn-external exit:void [x:int])
|
||||
|
||||
(defsys square:int
|
||||
[num:int]
|
||||
(return (* 1 num num)))
|
||||
|
||||
(defsys simple:int [x:int]
|
||||
(def xyz:int (+ 1 2 3))
|
||||
(return (* x 2 x)))
|
||||
|
||||
(defsys myprog:int []
|
||||
(def xyz:int (+ 1 2 3))
|
||||
(def abc:int (* 4 5 6))
|
||||
(def x:boolean (= xyz 5))
|
||||
(var i:int 0)
|
||||
(while (< i 10)
|
||||
(set i (+ 1 i))
|
||||
(printf "i = %d\n" i))
|
||||
(printf "hello, world!\n%d\n" (if x abc xyz))
|
||||
(return (simple (* abc xyz))))
|
||||
|
||||
(defsys doloop [x:int y:int]
|
||||
(var i:int x)
|
||||
(while (< i y)
|
||||
(set i (+ 1 i))
|
||||
(printf "i = %d\n" i))
|
||||
(myprog)
|
||||
(return x))
|
||||
|
||||
(defsys _start:void []
|
||||
#(syscall 1 1 "Hello, world!\n" 14)
|
||||
(doloop 10 20)
|
||||
(exit (the int 0))
|
||||
(return))
|
||||
|
||||
(defsys test_inttypes:ulong []
|
||||
(def x:ulong 123:u)
|
||||
(return (+ x x)))
|
||||
|
||||
(defsys test_arrays:myvec [a:myvec b:myvec]
|
||||
(return (+ a b)))
|
||||
|
||||
'(defsys make_array:myvec []
|
||||
(def vec:myvec [0 0 0 0])
|
||||
(return vec))
|
||||
|
||||
'(defsys make_mat:mymat []
|
||||
(def mat:mymat [[1 0 0 0] [0 1 0 0] [0 0 1 0] [0 0 0 1]])
|
||||
(return mat))
|
||||
|
||||
####
|
||||
|
||||
#(dump)
|
||||
#(dumpc)
|
||||
(dumpx64)
|
||||
@@ -1,10 +0,0 @@
|
||||
(def ir-asm
|
||||
'((link-name "redefine_type_fail")
|
||||
(type-prim Real f32)
|
||||
(type-prim 1 s32)
|
||||
(bind bob Real)
|
||||
(return bob)))
|
||||
|
||||
(def ctx (sysir/context))
|
||||
(sysir/asm ctx ir-asm)
|
||||
(print (sysir/to-c ctx))
|
||||
@@ -1,14 +0,0 @@
|
||||
(use ./frontend)
|
||||
|
||||
(def winmain
|
||||
'(defn Start:void []
|
||||
(MessageBoxExA (the pointer 0) "Hello, world!" "Test" 0 (the s16 0))
|
||||
(ExitProcess (the int 0))
|
||||
(return)))
|
||||
|
||||
####
|
||||
|
||||
(compile1 winmain)
|
||||
#(dump)
|
||||
#(dumpc)
|
||||
(dumpx64-windows)
|
||||
@@ -1,24 +0,0 @@
|
||||
(use ./frontend)
|
||||
|
||||
(defn-external printf:int [fmt:pointer x:int])
|
||||
(defn-external exit:void [x:int])
|
||||
|
||||
(defsys doloop [x:int y:int]
|
||||
(var i:int x)
|
||||
(printf "initial i = %d\n" i)
|
||||
(while (< i y)
|
||||
(set i (+ 1 i))
|
||||
(printf "i = %d\n" i))
|
||||
(return x))
|
||||
|
||||
(defsys _start:void []
|
||||
(doloop 10 20)
|
||||
(exit (the int 0))
|
||||
(return))
|
||||
|
||||
(defn main [& args]
|
||||
(def [_ what] args)
|
||||
(eprint "MODE: " what)
|
||||
(case what
|
||||
"c" (dumpc)
|
||||
"x64" (dumpx64)))
|
||||
5
janet.1
5
janet.1
@@ -214,7 +214,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting
|
||||
.BR \-m\ syspath
|
||||
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
|
||||
from a directory different than the default. The default is set when Janet is built, and defaults to
|
||||
/usr/local/lib/janet on Linux/Posix. On Windows, there is no default value. This option supersedes JANET_PATH.
|
||||
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
|
||||
|
||||
.TP
|
||||
.BR \-c\ source\ output
|
||||
@@ -255,7 +255,8 @@ and then arguments to the script.
|
||||
.RS
|
||||
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||
the default location set at compile time. This should be a colon-separated list of directory names on Linux/Posix, and a semicolon-separated list on Windows. Note that a typical setup (i.e. not NixOS / Guix) will only use a single directory.
|
||||
the default location set at compile time. This should be a list of as well as a colon
|
||||
separate list of such directories.
|
||||
.RE
|
||||
|
||||
.B JANET_PROFILE
|
||||
|
||||
28
meson.build
28
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2025 Calvin Rose and contributors
|
||||
# Copyright (c) 2024 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.40.0')
|
||||
version : '1.37.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -39,15 +39,6 @@ native_thread_dep = dependency('threads', native : true)
|
||||
# Deps
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
|
||||
# for MINGW/MSYS2
|
||||
native_ws2_dep = native_cc.find_library('ws2_32', required: false)
|
||||
native_psapi_dep = native_cc.find_library('psapi', required: false)
|
||||
native_wsock_dep = native_cc.find_library('wsock32', required: false)
|
||||
ws2_dep = cc.find_library('ws2_32', required: false)
|
||||
psapi_dep = cc.find_library('psapi', required: false)
|
||||
wsock_dep = cc.find_library('wsock32', required: false)
|
||||
|
||||
android_spawn_dep = cc.find_library('android-spawn', required : false)
|
||||
thread_dep = dependency('threads')
|
||||
|
||||
@@ -105,9 +96,6 @@ endif
|
||||
if get_option('arch_name') != ''
|
||||
conf.set('JANET_ARCH_NAME', get_option('arch_name'))
|
||||
endif
|
||||
if get_option('thread_local_prefix') != ''
|
||||
conf.set('JANET_THREAD_LOCAL', get_option('thread_local_prefix'))
|
||||
endif
|
||||
jconf = configure_file(output : 'janetconf.h',
|
||||
configuration : conf)
|
||||
|
||||
@@ -126,8 +114,7 @@ core_headers = [
|
||||
'src/core/regalloc.h',
|
||||
'src/core/compile.h',
|
||||
'src/core/emit.h',
|
||||
'src/core/symcache.h',
|
||||
'src/core/sysir.h',
|
||||
'src/core/symcache.h'
|
||||
]
|
||||
|
||||
core_src = [
|
||||
@@ -164,9 +151,6 @@ core_src = [
|
||||
'src/core/strtod.c',
|
||||
'src/core/struct.c',
|
||||
'src/core/symcache.c',
|
||||
'src/core/sysir.c',
|
||||
'src/core/sysir_c.c',
|
||||
'src/core/sysir_x86.c',
|
||||
'src/core/table.c',
|
||||
'src/core/tuple.c',
|
||||
'src/core/util.c',
|
||||
@@ -189,8 +173,8 @@ mainclient_src = [
|
||||
'src/mainclient/shell.c'
|
||||
]
|
||||
|
||||
janet_dependencies = [m_dep, dl_dep, android_spawn_dep, ws2_dep, psapi_dep, wsock_dep]
|
||||
janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep, native_ws2_dep, native_psapi_dep, native_wsock_dep]
|
||||
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
|
||||
janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep]
|
||||
if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
janet_native_dependencies += native_thread_dep
|
||||
@@ -285,7 +269,6 @@ test_files = [
|
||||
'test/suite-corelib.janet',
|
||||
'test/suite-debug.janet',
|
||||
'test/suite-ev.janet',
|
||||
'test/suite-ev2.janet',
|
||||
'test/suite-ffi.janet',
|
||||
'test/suite-filewatch.janet',
|
||||
'test/suite-inttypes.janet',
|
||||
@@ -301,7 +284,6 @@ test_files = [
|
||||
'test/suite-strtod.janet',
|
||||
'test/suite-struct.janet',
|
||||
'test/suite-symcache.janet',
|
||||
'test/suite-sysir.janet',
|
||||
'test/suite-table.janet',
|
||||
'test/suite-tuple.janet',
|
||||
'test/suite-unknown.janet',
|
||||
|
||||
@@ -30,7 +30,6 @@ option('max_macro_expand', type : 'integer', min : 1, max : 8000, value : 200)
|
||||
option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7fffffff)
|
||||
|
||||
option('arch_name', type : 'string', value: '')
|
||||
option('thread_local_prefix', type : 'string', value: '')
|
||||
option('os_name', type : 'string', value: '')
|
||||
option('shared', type : 'boolean', value: true)
|
||||
option('cryptorand', type : 'boolean', value: true)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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 2025 © Calvin Rose
|
||||
# Copyright 2024 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -7,7 +7,7 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def defn :macro :flycheck
|
||||
(def defn :macro
|
||||
```
|
||||
(defn name & more)
|
||||
|
||||
@@ -43,7 +43,7 @@
|
||||
# Build return value
|
||||
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
|
||||
|
||||
(defn defmacro :macro :flycheck
|
||||
(defn defmacro :macro
|
||||
"Define a macro."
|
||||
[name & more]
|
||||
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
|
||||
@@ -57,12 +57,12 @@
|
||||
[f & args]
|
||||
(f ;args))
|
||||
|
||||
(defmacro defmacro- :flycheck
|
||||
(defmacro defmacro-
|
||||
"Define a private macro that will not be exported."
|
||||
[name & more]
|
||||
(apply defn name :macro :private more))
|
||||
|
||||
(defmacro defn- :flycheck
|
||||
(defmacro defn-
|
||||
"Define a private function that will not be exported."
|
||||
[name & more]
|
||||
(apply defn name :private more))
|
||||
@@ -144,7 +144,7 @@
|
||||
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
|
||||
|
||||
(defmacro assert :flycheck # should top level assert flycheck?
|
||||
(defmacro assert
|
||||
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
|
||||
[x &opt err]
|
||||
(def v (gensym))
|
||||
@@ -154,11 +154,11 @@
|
||||
,v
|
||||
(,error ,(if err err (string/format "assert failure in %j" x))))))
|
||||
|
||||
(defmacro defdyn :flycheck
|
||||
(defmacro defdyn
|
||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||
alias is a normal, lexically scoped binding that can be used instead of
|
||||
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
|
||||
replace `dyn` and `setdyn`. The alias *must* start and end with the `*` character, usually
|
||||
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
|
||||
called "earmuffs".``
|
||||
[alias & more]
|
||||
(assert (symbol? alias) "alias must be a symbol")
|
||||
@@ -171,9 +171,6 @@
|
||||
(defdyn *macro-form*
|
||||
"Inside a macro, is bound to the source form that invoked the macro")
|
||||
|
||||
(defdyn *flychecking*
|
||||
"Check if the current form is being evaluated inside `flycheck`. Will be `true` while flychecking.")
|
||||
|
||||
(defdyn *lint-error*
|
||||
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
|
||||
|
||||
@@ -293,6 +290,22 @@
|
||||
(array/concat accum body)
|
||||
(tuple/slice accum 0))
|
||||
|
||||
(defmacro try
|
||||
``Try something and catch errors. `body` is any expression,
|
||||
and `catch` should be a form, the first element of which is a tuple. This tuple
|
||||
should contain a binding for errors and an optional binding for
|
||||
the fiber wrapping the body. Returns the result of `body` if no error,
|
||||
or the result of `catch` if an error.``
|
||||
[body catch]
|
||||
(let [[[err fib]] catch
|
||||
f (gensym)
|
||||
r (gensym)]
|
||||
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
|
||||
,r (,resume ,f)]
|
||||
(if (,= (,fiber/status ,f) :error)
|
||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||
,r))))
|
||||
|
||||
(defmacro protect
|
||||
`Evaluate expressions, while capturing any errors. Evaluates to a tuple
|
||||
of two elements. The first element is true if successful, false if an
|
||||
@@ -339,23 +352,6 @@
|
||||
(tuple 'if $fi $fi ret))))))
|
||||
ret)
|
||||
|
||||
(defmacro try
|
||||
``Try something and catch errors. `body` is any expression,
|
||||
and `catch` should be a form, the first element of which is a tuple. This tuple
|
||||
should contain a binding for errors and an optional binding for
|
||||
the fiber wrapping the body. Returns the result of `body` if no error,
|
||||
or the result of `catch` if an error.``
|
||||
[body catch]
|
||||
(assert (and (not (empty? catch)) (indexed? (catch 0))) "the first element of `catch` must be a tuple or array")
|
||||
(let [[err fib] (catch 0)
|
||||
r (or err (gensym))
|
||||
f (or fib (gensym))]
|
||||
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
|
||||
,r (,resume ,f)]
|
||||
(if (,= (,fiber/status ,f) :error)
|
||||
(do ,;(tuple/slice catch 1))
|
||||
,r))))
|
||||
|
||||
(defmacro with-syms
|
||||
"Evaluates `body` with each symbol in `syms` bound to a generated, unique symbol."
|
||||
[syms & body]
|
||||
@@ -1000,7 +996,7 @@
|
||||
|
||||
(defn reduce2
|
||||
``The 2-argument version of `reduce` that does not take an initialization value.
|
||||
Instead, the first element of the array is used for initialization. If `ind` is empty, will evaluate to nil.``
|
||||
Instead, the first element of the array is used for initialization.``
|
||||
[f ind]
|
||||
(var k (next ind))
|
||||
(if (= nil k) (break nil))
|
||||
@@ -1088,29 +1084,16 @@
|
||||
(map-aggregator ,maptype ,res (,f x ;call-buffer)))))))
|
||||
|
||||
(defn map
|
||||
```
|
||||
Map a function `f` over every value in a data structure `ind`
|
||||
and return an array of results, but only if no `inds` are
|
||||
provided. Multiple data structures can be handled if each
|
||||
`inds` is a data structure and `f` is a function of arity
|
||||
one more than the number of `inds`. The resulting array has
|
||||
a length that is the shortest of `ind` and each of `inds`.
|
||||
```
|
||||
`Map a function over every value in a data structure and
|
||||
return an array of the results.`
|
||||
[f ind & inds]
|
||||
(def res @[])
|
||||
(map-template :map res f ind inds)
|
||||
res)
|
||||
|
||||
(defn mapcat
|
||||
```
|
||||
Map a function `f` over every value in a data structure `ind`
|
||||
and use `array/concat` to concatenate the results, but only if
|
||||
no `inds` are provided. Multiple data structures can be handled
|
||||
if each `inds` is a data structure and `f` is a function of
|
||||
arity one more than the number of `inds`. Note that `f` is only
|
||||
applied to values at indeces up to the largest index of the
|
||||
shortest of `ind` and each of `inds`.
|
||||
```
|
||||
``Map a function over every element in an array or tuple and
|
||||
use `array/concat` to concatenate the results.``
|
||||
[f ind & inds]
|
||||
(def res @[])
|
||||
(map-template :mapcat res f ind inds)
|
||||
@@ -1127,30 +1110,18 @@
|
||||
res)
|
||||
|
||||
(defn count
|
||||
```
|
||||
Count the number of values in a data structure `ind` for which
|
||||
applying `pred` yields a truthy value, but only if no `inds` are
|
||||
provided. Multiple data structures can be handled if each `inds`
|
||||
is a data structure and `pred` is a function of arity one more
|
||||
than the number of `inds`. Note that `pred` is only applied to
|
||||
values at indeces up to the largest index of the shortest of
|
||||
`ind` and each of `inds`.
|
||||
```
|
||||
``Count the number of items in `ind` for which `(pred item)`
|
||||
is true.``
|
||||
[pred ind & inds]
|
||||
(var res 0)
|
||||
(map-template :count res pred ind inds)
|
||||
res)
|
||||
|
||||
(defn keep
|
||||
```
|
||||
Given a predicate `pred`, return a new array containing the
|
||||
truthy results of applying `pred` to each value in the data
|
||||
structure `ind`, but only if no `inds` are provided. Multiple
|
||||
data structures can be handled if each `inds` is a data
|
||||
structure and `pred` is a function of arity one more than the
|
||||
number of `inds`. The resulting array has a length that is no
|
||||
longer than the shortest of `ind` and each of `inds`.
|
||||
```
|
||||
``Given a predicate `pred`, return a new array containing the truthy results
|
||||
of applying `pred` to each element in the indexed collection `ind`. This is
|
||||
different from `filter` which returns an array of the original elements where
|
||||
the predicate is truthy.``
|
||||
[pred ind & inds]
|
||||
(def res @[])
|
||||
(map-template :keep res pred ind inds)
|
||||
@@ -1340,7 +1311,7 @@
|
||||
(defdyn *redef* "When set, allow dynamically rebinding top level defs. Will slow generated code and is intended to be used for development.")
|
||||
(defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
|
||||
(defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
|
||||
(defdyn *exit-value* "Set the return value from `run-context` upon an exit.")
|
||||
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
|
||||
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
|
||||
|
||||
(defdyn *current-file*
|
||||
@@ -1937,7 +1908,7 @@
|
||||
that will match any value without creating a binding.
|
||||
|
||||
While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
|
||||
where `<sym>` is any symbol, will attempt to match `x` against a value
|
||||
where <sym> is any symbol, will attempt to match `x` against a value
|
||||
already bound to `<sym>`, rather than matching and rebinding it.
|
||||
|
||||
Any other value pattern will only match if it is equal to `x`.
|
||||
@@ -2232,32 +2203,17 @@
|
||||
ret)
|
||||
|
||||
(defn all
|
||||
```
|
||||
Returns true if applying `pred` to every value in a data
|
||||
structure `ind` results in only truthy values, but only if no
|
||||
`inds` are provided. Multiple data structures can be handled
|
||||
if each `inds` is a data structure and `pred` is a function
|
||||
of arity one more than the number of `inds`. Returns the first
|
||||
falsey result encountered. Note that `pred` is only called as
|
||||
many times as the length of the shortest of `ind` and each of
|
||||
`inds`. If `ind` or any of `inds` are empty, returns true.
|
||||
```
|
||||
``Returns true if `(pred item)` is truthy for every item in `ind`.
|
||||
Otherwise, returns the first falsey result encountered.
|
||||
Returns true if `ind` is empty.``
|
||||
[pred ind & inds]
|
||||
(var res true)
|
||||
(map-template :all res pred ind inds)
|
||||
res)
|
||||
|
||||
(defn some
|
||||
```
|
||||
Returns nil if applying `pred` to every value in a data
|
||||
structure `ind` results in only falsey values, but only if no
|
||||
`inds` are provided. Multiple data structures can be handled
|
||||
if each `inds` is a data structure and `pred` is a function
|
||||
of arity one more than the number of `inds`. Returns the first
|
||||
truthy result encountered. Note that `pred` is only called as
|
||||
many times as the length of the shortest of `ind` and each of
|
||||
`inds`. If `ind` or any of `inds` are empty, returns nil.
|
||||
```
|
||||
``Returns nil if `(pred item)` is false or nil for every item in `ind`.
|
||||
Otherwise, returns the first truthy result encountered.``
|
||||
[pred ind & inds]
|
||||
(var res nil)
|
||||
(map-template :some res pred ind inds)
|
||||
@@ -2268,32 +2224,20 @@
|
||||
child values also immutable. Closures, fibers, and abstract types
|
||||
will not be recursively frozen, but all other types will.`
|
||||
[x]
|
||||
(def tx (type x))
|
||||
(cond
|
||||
(or (= tx :array) (= tx :tuple))
|
||||
(tuple/slice (map freeze x))
|
||||
|
||||
(or (= tx :table) (= tx :struct))
|
||||
(let [temp-tab @{}]
|
||||
# Handle multiple unique keys that freeze. Result should
|
||||
# be independent of iteration order.
|
||||
(eachp [k v] x
|
||||
(def kk (freeze k))
|
||||
(def vv (freeze v))
|
||||
(def old (get temp-tab kk))
|
||||
(def new (if (= nil old) vv (max vv old)))
|
||||
(put temp-tab kk new))
|
||||
(table/to-struct temp-tab (freeze (getproto x))))
|
||||
|
||||
(= tx :buffer)
|
||||
(string x)
|
||||
|
||||
(case (type x)
|
||||
:array (tuple/slice (map freeze x))
|
||||
:tuple (tuple/slice (map freeze x))
|
||||
:table (if-let [p (table/getproto x)]
|
||||
(freeze (merge (table/clone p) x))
|
||||
(struct ;(map freeze (kvs x))))
|
||||
:struct (struct ;(map freeze (kvs x)))
|
||||
:buffer (string x)
|
||||
x))
|
||||
|
||||
(defn thaw
|
||||
`Thaw an object (make it mutable) and do a deep copy, making
|
||||
child values also mutable. Closures, fibers, and abstract
|
||||
types will not be recursively thawed, but all other types will.`
|
||||
child value also mutable. Closures, fibers, and abstract
|
||||
types will not be recursively thawed, but all other types will`
|
||||
[ds]
|
||||
(case (type ds)
|
||||
:array (walk-ind thaw ds)
|
||||
@@ -2324,10 +2268,12 @@
|
||||
(or (= tx :struct) (= tx :table))
|
||||
(or (not= (length x) (length y))
|
||||
(do
|
||||
(def rawget (if (= tx :struct) struct/rawget table/rawget))
|
||||
(def rawget (if (= tx :table) table/rawget struct/rawget))
|
||||
(var ret false)
|
||||
(eachp [k v] x
|
||||
(if (deep-not= (rawget y k) v) (break (set ret true))))
|
||||
(def yv (rawget y k))
|
||||
(if (= nil yv) (break (set ret true)))
|
||||
(if (deep-not= yv v) (break (set ret true))))
|
||||
ret))
|
||||
(= tx :buffer) (not= 0 (- (length x) (length y)) (memcmp x y))
|
||||
(not= x y))))
|
||||
@@ -2357,7 +2303,7 @@
|
||||
|
||||
(set macexvar macex)
|
||||
|
||||
(defmacro varfn :flycheck
|
||||
(defmacro varfn
|
||||
``Create a function that can be rebound. `varfn` has the same signature
|
||||
as `defn`, but defines functions in the environment as vars. If a var `name`
|
||||
already exists in the environment, it is rebound to the new function. Returns
|
||||
@@ -2389,11 +2335,17 @@
|
||||
|
||||
(defmacro short-fn
|
||||
```
|
||||
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the
|
||||
0-indexed argument of the function. `$` is also an alias for the
|
||||
first (index 0) argument. The `$&` symbol will make the anonymous
|
||||
function variadic if it appears in the body of the function, and
|
||||
can be combined with positional arguments.
|
||||
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the 0-indexed
|
||||
argument of the function. `$` is also an alias for the first (index 0) argument.
|
||||
The `$&` symbol will make the anonymous function variadic if it appears in the
|
||||
body of the function, and can be combined with positional arguments.
|
||||
|
||||
Example usage:
|
||||
|
||||
(short-fn (+ $ $)) # A function that doubles its arguments.
|
||||
(short-fn (string $0 $1)) # accepting multiple args.
|
||||
|(+ $ $) # use pipe reader macro for terse function literals.
|
||||
|(+ $&) # variadic functions
|
||||
```
|
||||
[arg &opt name]
|
||||
(var max-param-seen -1)
|
||||
@@ -2578,7 +2530,7 @@
|
||||
* `:env` -- the environment to compile against - default is the current env
|
||||
|
||||
* `:source` -- source path for better errors (use keywords for non-paths) - default
|
||||
is `:<anonymous>`
|
||||
is :<anonymous>
|
||||
|
||||
* `:on-compile-error` -- callback when compilation fails - default is bad-compile
|
||||
|
||||
@@ -3184,17 +3136,12 @@
|
||||
use the name of the module as a prefix. One can also use "`:export true`"
|
||||
to re-export the imported symbols. If "`:exit true`" is given as an argument,
|
||||
any errors encountered at the top level in the module will cause `(os/exit 1)`
|
||||
to be called. Dynamic bindings will NOT be imported. Use :fresh with a truthy
|
||||
value to bypass the module cache. Use `:only [foo bar baz]` to only import
|
||||
select bindings into the current environment.``
|
||||
to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
|
||||
module cache. Use `:only [foo bar baz]` to only import select bindings into the
|
||||
current environment.``
|
||||
[path & args]
|
||||
(assertf (even? (length args)) "args should have even length: %n" args)
|
||||
(def ps (partition 2 args))
|
||||
(def argm
|
||||
(mapcat (fn [[k v]]
|
||||
(assertf (keyword? k) "expected keyword, got %s: %n" (type k) k)
|
||||
[k (case k :as (string v) :only ~(quote ,v) v)])
|
||||
ps))
|
||||
(def argm (mapcat (fn [[k v]] [k (case k :as (string v) :only ~(quote ,v) v)]) ps))
|
||||
(tuple import* (string path) ;argm))
|
||||
|
||||
(defmacro use
|
||||
@@ -3257,10 +3204,12 @@
|
||||
# Terminal codes for emission/tokenization
|
||||
(def delimiters
|
||||
(if has-color
|
||||
{:code ["\e[97m" "\e[39m"]
|
||||
{:underline ["\e[4m" "\e[24m"]
|
||||
:code ["\e[97m" "\e[39m"]
|
||||
:italics ["\e[4m" "\e[24m"]
|
||||
:bold ["\e[1m" "\e[22m"]}
|
||||
{:code ["`" "`"]
|
||||
{:underline ["_" "_"]
|
||||
:code ["`" "`"]
|
||||
:italics ["*" "*"]
|
||||
:bold ["**" "**"]}))
|
||||
(def modes @{})
|
||||
@@ -3391,6 +3340,7 @@
|
||||
(= 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)
|
||||
@@ -3922,15 +3872,9 @@
|
||||
|
||||
(compwhen (dyn 'net/listen)
|
||||
(defn net/server
|
||||
``
|
||||
Starts a server with `net/listen`. Runs `net/accept-loop` asynchronously if
|
||||
`handler` is set and `type` is `:stream` (the default). It is invalid to set
|
||||
`handler` if `type` is `:datagram`. Returns the new server stream.
|
||||
``
|
||||
[host port &opt handler type no-reuse]
|
||||
(assert (not (and (= type :datagram) handler))
|
||||
"handler not supported for :datagram servers")
|
||||
(def s (net/listen host port type no-reuse))
|
||||
"Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream."
|
||||
[host port &opt handler type]
|
||||
(def s (net/listen host port type))
|
||||
(if handler
|
||||
(ev/go (fn [] (net/accept-loop s handler))))
|
||||
s))
|
||||
@@ -3948,7 +3892,7 @@
|
||||
[& forms]
|
||||
(def state (gensym))
|
||||
(def loaded (gensym))
|
||||
~((fn :delay []
|
||||
~((fn []
|
||||
(var ,state nil)
|
||||
(var ,loaded nil)
|
||||
(fn []
|
||||
@@ -3980,7 +3924,7 @@
|
||||
:lazy lazy
|
||||
:map-symbols map-symbols}))
|
||||
|
||||
(defmacro ffi/defbind-alias :flycheck
|
||||
(defmacro ffi/defbind-alias
|
||||
"Generate bindings for native functions in a convenient manner.
|
||||
Similar to defbind but allows for the janet function name to be
|
||||
different than the FFI function."
|
||||
@@ -3991,8 +3935,6 @@
|
||||
(def formal-args (map 0 arg-pairs))
|
||||
(def type-args (map 1 arg-pairs))
|
||||
(def computed-type-args (eval ~[,;type-args]))
|
||||
(if (dyn *flychecking*)
|
||||
(break ~(defn ,alias ,;meta [,;formal-args] nil)))
|
||||
(def {:native lib
|
||||
:lazy lazy
|
||||
:native-lazy llib
|
||||
@@ -4008,7 +3950,7 @@
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
|
||||
|
||||
(defmacro ffi/defbind :flycheck
|
||||
(defmacro ffi/defbind
|
||||
"Generate bindings for native functions in a convenient manner."
|
||||
[name ret-type & body]
|
||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
||||
@@ -4019,51 +3961,6 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def- flycheck-specials @{})
|
||||
|
||||
(defn- flycheck-evaluator
|
||||
``
|
||||
An evaluator function that is passed to `run-context` that lints
|
||||
(flychecks) code for `flycheck`. This means code will be parsed,
|
||||
compiled, and have macros expanded, but the code will not be
|
||||
evaluated.
|
||||
``
|
||||
[thunk source env where]
|
||||
(when (and (tuple? source) (= (tuple/type source) :parens))
|
||||
(def head (source 0))
|
||||
(def entry (get env head {}))
|
||||
(def fc (get flycheck-specials head (get entry :flycheck)))
|
||||
(cond
|
||||
# Sometimes safe form
|
||||
(function? fc)
|
||||
(fc thunk source env where)
|
||||
# Always safe form
|
||||
fc
|
||||
(thunk))))
|
||||
|
||||
(defn flycheck
|
||||
```
|
||||
Check a file for errors without running the file. Found errors
|
||||
will be printed to stderr in the usual format. Top level functions
|
||||
and macros that have the metadata `:flycheck` will also be evaluated
|
||||
during flychecking. For full control, the `:flycheck` metadata can
|
||||
also be a function that takes 4 arguments - `thunk`, `source`, `env`,
|
||||
and `where`, the same as the `:evaluator` argument to `run-context`.
|
||||
Other arguments to `flycheck` are the same as `dofile`. Returns nil.
|
||||
```
|
||||
[path &keys kwargs]
|
||||
(def mc @{})
|
||||
(def new-env (make-env (get kwargs :env)))
|
||||
(put new-env *flychecking* true)
|
||||
(put new-env *module-cache* @{})
|
||||
(put new-env *module-loading* @{})
|
||||
(put new-env *module-make-env* (fn :make-flycheck-env [&] (make-env new-env)))
|
||||
(try
|
||||
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs) :env new-env)
|
||||
([e f]
|
||||
(debug/stacktrace f e "")))
|
||||
nil)
|
||||
|
||||
(defn- no-side-effects
|
||||
`Check if form may have side effects. If returns true, then the src
|
||||
must not have side effects, such as calling a C function.`
|
||||
@@ -4079,29 +3976,59 @@
|
||||
(all no-side-effects (values src)))
|
||||
true))
|
||||
|
||||
(defn- is-safe-def [thunk source env where]
|
||||
(if (no-side-effects (last source))
|
||||
(thunk)))
|
||||
(defn- is-safe-def [x] (no-side-effects (last x)))
|
||||
|
||||
(defn- flycheck-importer
|
||||
(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true
|
||||
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
|
||||
'defglobal is-safe-def 'varglobal is-safe-def})
|
||||
|
||||
(def- importers {'import true 'import* true 'dofile true 'require true})
|
||||
(defn- use-2 [evaluator args]
|
||||
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
|
||||
|
||||
(defn- flycheck-evaluator
|
||||
``An evaluator function that is passed to `run-context` that lints (flychecks) code.
|
||||
This means code will parsed and compiled, macros executed, but the code will not be run.
|
||||
Used by `flycheck`.``
|
||||
[thunk source env where]
|
||||
(let [[l c] (tuple/sourcemap source)
|
||||
newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
|
||||
((compile newtup env where))))
|
||||
(when (tuple? source)
|
||||
(def head (source 0))
|
||||
(def safe-check
|
||||
(or
|
||||
(safe-forms head)
|
||||
(if (symbol? head)
|
||||
(if (string/has-prefix? "define-" head) is-safe-def))))
|
||||
(cond
|
||||
# Sometimes safe form
|
||||
(function? safe-check)
|
||||
(if (safe-check source) (thunk))
|
||||
# Always safe form
|
||||
safe-check
|
||||
(thunk)
|
||||
# Use
|
||||
(= 'use head)
|
||||
(use-2 flycheck-evaluator (tuple/slice source 1))
|
||||
# Import-like form
|
||||
(importers head)
|
||||
(let [[l c] (tuple/sourcemap source)
|
||||
newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
|
||||
((compile newtup env where))))))
|
||||
|
||||
(defn- flycheck-use
|
||||
[thunk source env where]
|
||||
(each a (drop 1 source) (import* (string a) :prefix "" :evaluator flycheck-evaluator)))
|
||||
|
||||
# Add metadata to defs and import macros for flychecking
|
||||
(each sym ['def 'var]
|
||||
(put flycheck-specials sym is-safe-def))
|
||||
(each sym ['def- 'var- 'defglobal 'varglobal]
|
||||
(put (dyn sym) :flycheck is-safe-def))
|
||||
(each sym ['import 'import* 'dofile 'require]
|
||||
(put (dyn sym) :flycheck flycheck-importer))
|
||||
(each sym ['use]
|
||||
(put (dyn sym) :flycheck flycheck-use))
|
||||
(defn flycheck
|
||||
``Check a file for errors without running the file. Found errors will be printed to stderr
|
||||
in the usual format. Macros will still be executed, however, so
|
||||
arbitrary execution is possible. Other arguments are the same as `dofile`. `path` can also be
|
||||
a file value such as stdin. Returns nil.``
|
||||
[path &keys kwargs]
|
||||
(def old-modcache (table/clone module/cache))
|
||||
(table/clear module/cache)
|
||||
(try
|
||||
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
|
||||
([e f]
|
||||
(debug/stacktrace f e "")))
|
||||
(table/clear module/cache)
|
||||
(merge-into module/cache old-modcache)
|
||||
nil)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -4187,11 +4114,7 @@
|
||||
[manifest]
|
||||
(def bn (get manifest :name))
|
||||
(def manifest-name (get-manifest-filename bn))
|
||||
(def b @"")
|
||||
(buffer/format b "%j" manifest) # make sure it is valid jdn
|
||||
(buffer/clear b)
|
||||
(buffer/format b "%.99m\n" manifest)
|
||||
(spit manifest-name b))
|
||||
(spit manifest-name (string/format "%j\n" manifest)))
|
||||
|
||||
(defn bundle/manifest
|
||||
"Get the manifest for a give installed bundle"
|
||||
@@ -4210,7 +4133,7 @@
|
||||
(os/cd workdir)
|
||||
([_] (print "cannot enter source directory " workdir " for bundle " bundle-name)))
|
||||
(defer (os/cd dir)
|
||||
(def new-env (make-env))
|
||||
(def new-env (make-env (curenv)))
|
||||
(put new-env *module-cache* @{})
|
||||
(put new-env *module-loading* @{})
|
||||
(put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env)))
|
||||
@@ -4225,6 +4148,7 @@
|
||||
[module bundle-name hook & args]
|
||||
(def hookf (module/value module (symbol hook)))
|
||||
(unless hookf (break))
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def dir (os/cwd))
|
||||
(os/cd (get module :workdir "."))
|
||||
(defer (os/cd dir)
|
||||
@@ -4325,49 +4249,51 @@
|
||||
"Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`."
|
||||
[path &keys config]
|
||||
(def path (bundle-rpath path))
|
||||
(def clean (get config :clean))
|
||||
(def check (get config :check))
|
||||
(def s (sep))
|
||||
# Detect bundle name
|
||||
(def infofile-src1 (string path s "bundle" s "info.jdn"))
|
||||
(def infofile-src2 (string path s "info.jdn"))
|
||||
(def infofile-src (cond (fexists infofile-src1) infofile-src1
|
||||
(fexists infofile-src2) infofile-src2))
|
||||
(def info (-?> infofile-src slurp parse))
|
||||
(def bundle-name (get config :name (get info :name)))
|
||||
# Check meta file for dependencies and default name
|
||||
(def infofile-pre-1 (string path s "bundle" s "info.jdn"))
|
||||
(def infofile-pre (if (fexists infofile-pre-1) infofile-pre-1 (string path s "info.jdn"))) # allow for alias
|
||||
(var default-bundle-name nil)
|
||||
(when (os/stat infofile-pre :mode)
|
||||
(def info (-> infofile-pre slurp parse))
|
||||
(def deps (get info :dependencies @[]))
|
||||
(set default-bundle-name (get info :name))
|
||||
(def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
|
||||
(when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
|
||||
(def bundle-name (get config :name default-bundle-name))
|
||||
(assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
|
||||
(assertf (not (string/check-set "\\/" bundle-name))
|
||||
"bundle name %v cannot contain path separators" bundle-name)
|
||||
(assert (next bundle-name) "cannot use empty bundle-name")
|
||||
(assertf (not (fexists (get-manifest-filename bundle-name)))
|
||||
"bundle %v is already installed" bundle-name)
|
||||
(assert (not (fexists (get-manifest-filename bundle-name)))
|
||||
"bundle is already installed")
|
||||
# Setup installed paths
|
||||
(prime-bundle-paths)
|
||||
(os/mkdir (bundle-dir bundle-name))
|
||||
# Copy infofile
|
||||
(def infofile-dest (bundle-file bundle-name "info.jdn"))
|
||||
(when infofile-src (copyfile infofile-src infofile-dest))
|
||||
# Copy aliased initfile
|
||||
(def initfile-alias (string path s "bundle.janet"))
|
||||
(def initfile-dest (bundle-file bundle-name "init.janet"))
|
||||
(when (fexists initfile-alias) (copyfile initfile-alias initfile-dest))
|
||||
# Aliases for common bundle/ files
|
||||
(def bundle.janet (string path s "bundle.janet"))
|
||||
(when (fexists bundle.janet) (copyfile bundle.janet (bundle-file bundle-name "init.janet")))
|
||||
(when (fexists infofile-pre) (copyfile infofile-pre (bundle-file bundle-name "info.jdn")))
|
||||
# Copy some files into the new location unconditionally
|
||||
(def implicit-sources (string path s "bundle"))
|
||||
(when (= :directory (os/stat implicit-sources :mode))
|
||||
(copyrf implicit-sources (bundle-dir bundle-name)))
|
||||
(def man @{:name bundle-name :local-source path :files @[]})
|
||||
(merge-into man config)
|
||||
(def infofile (bundle-file bundle-name "info.jdn"))
|
||||
(put man :auto-remove (get config :auto-remove))
|
||||
(sync-manifest man)
|
||||
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
|
||||
(when (os/stat infofile-dest :mode)
|
||||
(def info (-> infofile-dest slurp parse))
|
||||
(def deps (seq [d :in (get info :dependencies @[])]
|
||||
(string (if (dictionary? d) (get d :name) d))))
|
||||
(when (os/stat infofile :mode)
|
||||
(def info (-> infofile slurp parse))
|
||||
(def deps (get info :dependencies @[]))
|
||||
(def missing (filter (complement bundle/installed?) deps))
|
||||
(when (next missing)
|
||||
(error (string "missing dependencies " (string/join missing ", "))))
|
||||
(put man :dependencies deps)
|
||||
(put man :info info))
|
||||
(def clean (get config :clean))
|
||||
(def check (get config :check))
|
||||
(def module (get-bundle-module bundle-name))
|
||||
(def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
|
||||
(put man :hooks all-hooks)
|
||||
@@ -4381,9 +4307,6 @@
|
||||
(when check
|
||||
(do-hook module bundle-name :check man)))
|
||||
(print "installed " bundle-name)
|
||||
(when (get man :has-bin-script)
|
||||
(def binpath (string (dyn *syspath*) s "bin"))
|
||||
(eprintf "executable scripts have been installed to %s" binpath))
|
||||
bundle-name)
|
||||
|
||||
(defn- bundle/pack
|
||||
@@ -4418,15 +4341,14 @@
|
||||
(spit install-hook b))
|
||||
dest-dir)
|
||||
|
||||
(defn bundle/replace
|
||||
"Reinstall an existing bundle from a new directory. Similar to bundle/reinstall,
|
||||
but installs the replacement bundle from any directory. This is necesarry to replace a package without
|
||||
breaking any dependencies."
|
||||
[bundle-name path &keys new-config]
|
||||
(defn bundle/reinstall
|
||||
"Reinstall an existing bundle from the local source code."
|
||||
[bundle-name &keys new-config]
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def path (get manifest :local-source))
|
||||
(def config (get manifest :config @{}))
|
||||
(def s (sep))
|
||||
(assertf (= :directory (os/stat path :mode)) "local source %v not available" path)
|
||||
(assert (= :directory (os/stat path :mode)) "local source not available")
|
||||
(def backup-dir (string (dyn *syspath*) s bundle-name ".backup"))
|
||||
(rmrf backup-dir)
|
||||
(def backup-bundle-source (bundle/pack bundle-name backup-dir true))
|
||||
@@ -4439,14 +4361,6 @@
|
||||
(rmrf backup-bundle-source)
|
||||
bundle-name)
|
||||
|
||||
(defn bundle/reinstall
|
||||
"Reinstall an existing bundle from the local source code."
|
||||
[bundle-name &keys new-config]
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def path (get manifest :local-source))
|
||||
(bundle/replace bundle-name path ;(kvs new-config))
|
||||
bundle-name)
|
||||
|
||||
(defn bundle/add-directory
|
||||
"Add a directory during the install process relative to `(dyn *syspath*)`"
|
||||
[manifest dest &opt chmod-mode]
|
||||
@@ -4494,7 +4408,7 @@
|
||||
|
||||
(defn bundle/add
|
||||
"Add files and directories during a bundle install relative to `(dyn *syspath*)`.
|
||||
Added files and directories will be recorded in the bundle manifest such that they are properly tracked
|
||||
Added paths will be recorded in the bundle manifest such that they are properly tracked
|
||||
and removed during an upgrade or uninstall."
|
||||
[manifest src &opt dest chmod-mode]
|
||||
(default dest src)
|
||||
@@ -4510,17 +4424,13 @@
|
||||
(errorf "bad path %s - file is a %s" src mode)))
|
||||
|
||||
(defn bundle/add-bin
|
||||
``
|
||||
Shorthand for adding scripts during an install. Scripts will be installed to
|
||||
`(string (dyn *syspath*) "/bin")` by default and will be set to be executable.
|
||||
``
|
||||
`Shorthand for adding scripts during an install. Scripts will be installed to
|
||||
(string (dyn *syspath*) "/bin") by default and will be set to be executable.`
|
||||
[manifest src &opt dest chmod-mode]
|
||||
(def s (sep))
|
||||
(default dest (last (string/split s src)))
|
||||
(default dest (last (string/split "/" src)))
|
||||
(default chmod-mode 8r755)
|
||||
(os/mkdir (string (dyn *syspath*) s "bin"))
|
||||
(put manifest :has-bin-script true)
|
||||
(bundle/add-file manifest src (string "bin" s dest) chmod-mode))
|
||||
(os/mkdir (string (dyn *syspath*) (sep) "bin"))
|
||||
(bundle/add-file manifest src (string "bin" (sep) dest) chmod-mode))
|
||||
|
||||
(defn bundle/update-all
|
||||
"Reinstall all bundles"
|
||||
@@ -4583,12 +4493,6 @@
|
||||
"-nocolor" "n"
|
||||
"-color" "N"
|
||||
"-library" "l"
|
||||
"-install" "b"
|
||||
"-reinstall" "B"
|
||||
"-uninstall" "u"
|
||||
"-update-all" "U"
|
||||
"-list" "L"
|
||||
"-prune" "P"
|
||||
"-lint-warn" "w"
|
||||
"-lint-error" "x"})
|
||||
|
||||
@@ -4599,7 +4503,7 @@
|
||||
|
||||
(setdyn *args* args)
|
||||
|
||||
(var should-repl nil)
|
||||
(var should-repl false)
|
||||
(var no-file true)
|
||||
(var quiet false)
|
||||
(var raw-stdin false)
|
||||
@@ -4654,12 +4558,6 @@
|
||||
--library (-l) lib : Use a module before processing more arguments
|
||||
--lint-warn (-w) level : Set the lint warning level - default is "normal"
|
||||
--lint-error (-x) level : Set the lint error level - default is "none"
|
||||
--install (-b) dirpath : Install a bundle from a directory
|
||||
--reinstall (-B) name : Reinstall a bundle by bundle name
|
||||
--uninstall (-u) name : Uninstall a bundle by bundle name
|
||||
--update-all (-U) : Reinstall all installed bundles
|
||||
--prune (-P) : Uninstall all bundles that are orphaned
|
||||
--list (-L) : List all installed bundles
|
||||
-- : Stop handling options
|
||||
```)
|
||||
(os/exit 0)
|
||||
@@ -4704,30 +4602,6 @@
|
||||
((thunk) ;subargs)
|
||||
(error (get thunk :error)))
|
||||
math/inf)
|
||||
"b"
|
||||
(compif (dyn 'bundle/install)
|
||||
(fn [i &] (bundle/install (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
|
||||
(fn [i &] (eprint "--install not supported with reduced os") 2))
|
||||
"B"
|
||||
(compif (dyn 'bundle/reinstall)
|
||||
(fn [i &] (bundle/reinstall (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
|
||||
(fn [i &] (eprint "--reinstall not supported with reduced os") 2))
|
||||
"u"
|
||||
(compif (dyn 'bundle/uninstall)
|
||||
(fn [i &] (bundle/uninstall (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
|
||||
(fn [i &] (eprint "--uninstall not supported with reduced os") 2))
|
||||
"P"
|
||||
(compif (dyn 'bundle/prune)
|
||||
(fn [i &] (bundle/prune) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||
(fn [i &] (eprint "--prune not supported with reduced os") 1))
|
||||
"U"
|
||||
(compif (dyn 'bundle/update-all)
|
||||
(fn [i &] (bundle/update-all) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||
(fn [i &] (eprint "--update-all not supported with reduced os") 1))
|
||||
"L"
|
||||
(compif (dyn 'bundle/list)
|
||||
(fn [i &] (each l (bundle/list) (print l)) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||
(fn [i &] (eprint "--list not supported with reduced os") 1))
|
||||
"d" (fn [&] (set debug-flag true) 1)
|
||||
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
|
||||
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
|
||||
@@ -4865,8 +4739,7 @@
|
||||
"src/core/regalloc.h"
|
||||
"src/core/compile.h"
|
||||
"src/core/emit.h"
|
||||
"src/core/symcache.h"
|
||||
"src/core/sysir.h"])
|
||||
"src/core/symcache.h"])
|
||||
|
||||
(def core-sources
|
||||
["src/core/abstract.c"
|
||||
@@ -4902,9 +4775,6 @@
|
||||
"src/core/strtod.c"
|
||||
"src/core/struct.c"
|
||||
"src/core/symcache.c"
|
||||
"src/core/sysir.c"
|
||||
"src/core/sysir_c.c"
|
||||
"src/core/sysir_x86.c"
|
||||
"src/core/table.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/util.c"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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,16 +4,15 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 40
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_MINOR 37
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.40.0"
|
||||
#define JANET_VERSION "1.37.1"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
/* These settings all affect linking, so use cautiously. */
|
||||
/* #define JANET_SINGLE_THREADED */
|
||||
/* #define JANET_THREAD_LOCAL _Thread_local */
|
||||
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||
/* #define JANET_NO_NANBOX */
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -164,7 +164,7 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||
|
||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
|
||||
if (ret) janet_panicf("cannot release lock: %s", strerror(ret));
|
||||
if (ret) janet_panic("cannot release lock");
|
||||
}
|
||||
|
||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -64,11 +64,6 @@ void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm.return_reg != NULL) {
|
||||
/* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */
|
||||
if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) {
|
||||
#ifdef JANET_EV
|
||||
if (NULL != janet_vm.root_fiber && sig == JANET_SIGNAL_EVENT) {
|
||||
janet_vm.root_fiber->sched_id++;
|
||||
}
|
||||
#endif
|
||||
if (sig != JANET_SIGNAL_ERROR) {
|
||||
message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig]));
|
||||
}
|
||||
@@ -589,16 +584,6 @@ JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
|
||||
#endif
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_load_relaxed(JanetAtomicInt volatile *x) {
|
||||
#ifdef _MSC_VER
|
||||
return _InterlockedOr(x, 0);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_load_explicit(x, memory_order_relaxed);
|
||||
#else
|
||||
return __atomic_load_n(x, __ATOMIC_RELAXED);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Some definitions for function-like macros */
|
||||
|
||||
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -1127,5 +1127,4 @@ void janet_lib_compile(JanetTable *env) {
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
janet_lib_sysir(env);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -268,9 +268,6 @@ JanetSlot janetc_cslot(Janet x);
|
||||
/* Search for a symbol */
|
||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Load the system dialect IR */
|
||||
void janet_lib_sysir(JanetTable *env);
|
||||
|
||||
/* Bytecode optimization */
|
||||
void janet_bytecode_movopt(JanetFuncDef *def);
|
||||
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -66,7 +66,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
JanetBuildConfig modconf = getter();
|
||||
JanetBuildConfig host = janet_config_current();
|
||||
if (host.major != modconf.major ||
|
||||
host.minor != modconf.minor ||
|
||||
host.minor < modconf.minor ||
|
||||
host.bits != modconf.bits) {
|
||||
char errbuf[128];
|
||||
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||
@@ -449,9 +449,8 @@ JANET_CORE_FN(janet_core_range,
|
||||
}
|
||||
count = (count > 0) ? count : 0;
|
||||
int32_t int_count;
|
||||
janet_assert(count >= 0, "bad range code");
|
||||
if (count > (double) INT32_MAX) {
|
||||
janet_panicf("range is too large, %f elements", count);
|
||||
int_count = INT32_MAX;
|
||||
} else {
|
||||
int_count = (int32_t) ceil(count);
|
||||
}
|
||||
@@ -653,15 +652,22 @@ JANET_CORE_FN(janet_core_check_int,
|
||||
"(int? x)",
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checkint(argv[0]));
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
return janet_wrap_boolean(num == (double)((int32_t)num));
|
||||
ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_check_nat,
|
||||
"(nat? x)",
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checkint(argv[0])) return janet_wrap_false();
|
||||
return janet_wrap_boolean(janet_unwrap_integer(argv[0]) >= 0);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num)));
|
||||
ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_bytes,
|
||||
@@ -746,7 +752,6 @@ typedef struct SandboxOption {
|
||||
|
||||
static const SandboxOption sandbox_options[] = {
|
||||
{"all", JANET_SANDBOX_ALL},
|
||||
{"chroot", JANET_SANDBOX_CHROOT},
|
||||
{"env", JANET_SANDBOX_ENV},
|
||||
{"ffi", JANET_SANDBOX_FFI},
|
||||
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
||||
@@ -772,7 +777,6 @@ JANET_CORE_FN(janet_core_sandbox,
|
||||
"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"
|
||||
"* :chroot - disallow calling `os/posix-chroot`\n"
|
||||
"* :env - disallow reading and write env variables\n"
|
||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
||||
@@ -997,11 +1001,12 @@ static void make_apply(JanetTable *env) {
|
||||
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
||||
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
|
||||
JDOC("(apply f & args)\n\n"
|
||||
"Applies a function f to a variable number of arguments. Each "
|
||||
"element in args is used as an argument to f, except the last "
|
||||
"element in args, which is expected to be an array or a tuple. "
|
||||
"Each element in this last argument is then also pushed as an "
|
||||
"argument to f."));
|
||||
"Applies a function to a variable number of arguments. Each element in args "
|
||||
"is used as an argument to f, except the last element in args, which is expected to "
|
||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||
"f. For example:\n\n"
|
||||
"\t(apply + 1000 (range 10))\n\n"
|
||||
"sums the first 10 integers and 1000."));
|
||||
}
|
||||
|
||||
static const uint32_t error_asm[] = {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
|
||||
273
src/core/ev.c
273
src/core/ev.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -112,16 +112,6 @@ typedef struct {
|
||||
JanetHandle write_pipe;
|
||||
} JanetEVThreadInit;
|
||||
|
||||
/* Structure used to initialize threads that run timeouts */
|
||||
typedef struct {
|
||||
double sec;
|
||||
JanetVM *vm;
|
||||
JanetFiber *fiber;
|
||||
#ifdef JANET_WINDOWS
|
||||
HANDLE cancel_event;
|
||||
#endif
|
||||
} JanetThreadedTimeout;
|
||||
|
||||
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF
|
||||
|
||||
static void janet_q_init(JanetQueue *q) {
|
||||
@@ -356,22 +346,21 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
|
||||
|
||||
static void janet_stream_close_impl(JanetStream *stream) {
|
||||
stream->flags |= JANET_STREAM_CLOSED;
|
||||
int canclose = !(stream->flags & JANET_STREAM_NOT_CLOSEABLE);
|
||||
#ifdef JANET_WINDOWS
|
||||
if (stream->handle != INVALID_HANDLE_VALUE) {
|
||||
#ifdef JANET_NET
|
||||
if (stream->flags & JANET_STREAM_SOCKET) {
|
||||
if (canclose) closesocket((SOCKET) stream->handle);
|
||||
closesocket((SOCKET) stream->handle);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
if (canclose) CloseHandle(stream->handle);
|
||||
CloseHandle(stream->handle);
|
||||
}
|
||||
stream->handle = INVALID_HANDLE_VALUE;
|
||||
}
|
||||
#else
|
||||
if (stream->handle != -1) {
|
||||
if (canclose) close(stream->handle);
|
||||
close(stream->handle);
|
||||
stream->handle = -1;
|
||||
#ifdef JANET_EV_POLL
|
||||
uint32_t i = stream->index;
|
||||
@@ -607,43 +596,8 @@ void janet_ev_init_common(void) {
|
||||
#endif
|
||||
}
|
||||
|
||||
#if JANET_ANDROID
|
||||
static void janet_timeout_stop(int sig_num) {
|
||||
if (sig_num == SIGUSR1) {
|
||||
pthread_exit(0);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
static void handle_timeout_worker(JanetTimeout to, int cancel) {
|
||||
if (!to.has_worker) return;
|
||||
#ifdef JANET_WINDOWS
|
||||
if (cancel && to.worker_event) {
|
||||
SetEvent(to.worker_event);
|
||||
}
|
||||
WaitForSingleObject(to.worker, INFINITE);
|
||||
CloseHandle(to.worker);
|
||||
if (to.worker_event) {
|
||||
CloseHandle(to.worker_event);
|
||||
}
|
||||
#else
|
||||
#ifdef JANET_ANDROID
|
||||
if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill");
|
||||
#else
|
||||
if (cancel) janet_assert(!pthread_cancel(to.worker), "pthread_cancel");
|
||||
#endif
|
||||
void *res = NULL;
|
||||
janet_assert(!pthread_join(to.worker, &res), "pthread_join");
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Common deinit code */
|
||||
void janet_ev_deinit_common(void) {
|
||||
JanetTimeout to;
|
||||
while (peek_timeout(&to)) {
|
||||
handle_timeout_worker(to, 1);
|
||||
pop_timeout(0);
|
||||
}
|
||||
janet_q_deinit(&janet_vm.spawn);
|
||||
janet_free(janet_vm.tq);
|
||||
janet_table_deinit(&janet_vm.threaded_abstracts);
|
||||
@@ -669,7 +623,6 @@ void janet_addtimeout(double sec) {
|
||||
to.curr_fiber = NULL;
|
||||
to.sched_id = fiber->sched_id;
|
||||
to.is_error = 1;
|
||||
to.has_worker = 0;
|
||||
add_timeout(to);
|
||||
}
|
||||
|
||||
@@ -682,61 +635,9 @@ void janet_addtimeout_nil(double sec) {
|
||||
to.curr_fiber = NULL;
|
||||
to.sched_id = fiber->sched_id;
|
||||
to.is_error = 0;
|
||||
to.has_worker = 0;
|
||||
add_timeout(to);
|
||||
}
|
||||
|
||||
static void janet_timeout_cb(JanetEVGenericMessage msg) {
|
||||
(void) msg;
|
||||
janet_interpreter_interrupt_handled(&janet_vm);
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
|
||||
JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
|
||||
janet_free(ptr);
|
||||
JanetTimestamp wait_begin = ts_now();
|
||||
DWORD duration = (DWORD)round(tto.sec * 1000);
|
||||
DWORD res = WAIT_TIMEOUT;
|
||||
JanetTimestamp wait_end = ts_now();
|
||||
for (size_t i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
|
||||
res = WaitForSingleObject(tto.cancel_event, (duration + i));
|
||||
wait_end = ts_now();
|
||||
}
|
||||
/* only send interrupt message if result is WAIT_TIMEOUT */
|
||||
if (res == WAIT_TIMEOUT) {
|
||||
janet_interpreter_interrupt(tto.vm);
|
||||
JanetEVGenericMessage msg = {0};
|
||||
janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
static void *janet_timeout_body(void *ptr) {
|
||||
#ifdef JANET_ANDROID
|
||||
struct sigaction action;
|
||||
memset(&action, 0, sizeof(action));
|
||||
sigemptyset(&action.sa_mask);
|
||||
action.sa_flags = 0;
|
||||
action.sa_handler = &janet_timeout_stop;
|
||||
sigaction(SIGUSR1, &action, NULL);
|
||||
#endif
|
||||
JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
|
||||
janet_free(ptr);
|
||||
struct timespec ts;
|
||||
ts.tv_sec = (time_t) tto.sec;
|
||||
ts.tv_nsec = (tto.sec <= UINT32_MAX)
|
||||
? (long)((tto.sec - ((uint32_t)tto.sec)) * 1000000000)
|
||||
: 0;
|
||||
nanosleep(&ts, &ts);
|
||||
janet_interpreter_interrupt(tto.vm);
|
||||
JanetEVGenericMessage msg = {0};
|
||||
janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
|
||||
return NULL;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
void janet_ev_inc_refcount(void) {
|
||||
janet_atomic_inc(&janet_vm.listener_count);
|
||||
}
|
||||
@@ -851,34 +752,6 @@ static int janet_chanat_gc(void *p, size_t s) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void janet_chanat_remove_vmref(JanetQueue *fq) {
|
||||
JanetChannelPending *pending = fq->data;
|
||||
if (fq->head <= fq->tail) {
|
||||
for (int32_t i = fq->head; i < fq->tail; i++) {
|
||||
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
|
||||
}
|
||||
} else {
|
||||
for (int32_t i = fq->head; i < fq->capacity; i++) {
|
||||
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
|
||||
}
|
||||
for (int32_t i = 0; i < fq->tail; i++) {
|
||||
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static int janet_chanat_gcperthread(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetChannel *chan = p;
|
||||
janet_chan_lock(chan);
|
||||
/* Make sure that the internals of the threaded channel no longer reference _this_ thread. Replace
|
||||
* those references with NULL. */
|
||||
janet_chanat_remove_vmref(&chan->read_pending);
|
||||
janet_chanat_remove_vmref(&chan->write_pending);
|
||||
janet_chan_unlock(chan);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void janet_chanat_mark_fq(JanetQueue *fq) {
|
||||
JanetChannelPending *pending = fq->data;
|
||||
if (fq->head <= fq->tail) {
|
||||
@@ -961,9 +834,8 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
|
||||
if (is_read) {
|
||||
JanetChannelPending reader;
|
||||
while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
|
||||
if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
|
||||
JanetVM *vm = reader.thread;
|
||||
if (!vm) continue;
|
||||
JanetEVGenericMessage msg;
|
||||
msg.tag = reader.mode;
|
||||
msg.fiber = reader.fiber;
|
||||
@@ -971,13 +843,11 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
msg.argp = channel;
|
||||
msg.argj = x;
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
JanetChannelPending writer;
|
||||
while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
|
||||
if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
|
||||
JanetVM *vm = writer.thread;
|
||||
if (!vm) continue;
|
||||
JanetEVGenericMessage msg;
|
||||
msg.tag = writer.mode;
|
||||
msg.fiber = writer.fiber;
|
||||
@@ -985,7 +855,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
msg.argp = channel;
|
||||
msg.argj = janet_wrap_nil();
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1049,9 +918,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
|
||||
msg.argi = (int32_t) reader.sched_id;
|
||||
msg.argp = channel;
|
||||
msg.argj = x;
|
||||
if (vm) {
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
} else {
|
||||
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
||||
janet_schedule(reader.fiber, make_read_result(channel, x));
|
||||
@@ -1106,9 +973,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
|
||||
msg.argi = (int32_t) writer.sched_id;
|
||||
msg.argp = channel;
|
||||
msg.argj = janet_wrap_nil();
|
||||
if (vm) {
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
} else {
|
||||
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
||||
janet_schedule(writer.fiber, make_write_result(channel));
|
||||
@@ -1172,9 +1037,6 @@ JANET_CORE_FN(cfun_channel_push,
|
||||
"Returns the channel if the write succeeded, nil otherwise.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetChannel *channel = janet_getchannel(argv, 0);
|
||||
if (janet_vm.coerce_error) {
|
||||
janet_panic("cannot give to channel inside janet_call");
|
||||
}
|
||||
if (janet_channel_push(channel, argv[1], 0)) {
|
||||
janet_await();
|
||||
}
|
||||
@@ -1187,9 +1049,6 @@ JANET_CORE_FN(cfun_channel_pop,
|
||||
janet_fixarity(argc, 1);
|
||||
JanetChannel *channel = janet_getchannel(argv, 0);
|
||||
Janet item;
|
||||
if (janet_vm.coerce_error) {
|
||||
janet_panic("cannot take from channel inside janet_call");
|
||||
}
|
||||
if (janet_channel_pop(channel, &item, 0)) {
|
||||
janet_schedule(janet_vm.root_fiber, item);
|
||||
}
|
||||
@@ -1226,10 +1085,6 @@ JANET_CORE_FN(cfun_channel_choice,
|
||||
int32_t len;
|
||||
const Janet *data;
|
||||
|
||||
if (janet_vm.coerce_error) {
|
||||
janet_panic("cannot select from channel inside janet_call");
|
||||
}
|
||||
|
||||
/* Check channels for immediate reads and writes */
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
||||
@@ -1372,9 +1227,7 @@ JANET_CORE_FN(cfun_channel_close,
|
||||
msg.tag = JANET_CP_MODE_CLOSE;
|
||||
msg.argi = (int32_t) writer.sched_id;
|
||||
msg.argj = janet_wrap_nil();
|
||||
if (vm) {
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
} else {
|
||||
if (janet_fiber_can_resume(writer.fiber)) {
|
||||
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
||||
@@ -1395,9 +1248,7 @@ JANET_CORE_FN(cfun_channel_close,
|
||||
msg.tag = JANET_CP_MODE_CLOSE;
|
||||
msg.argi = (int32_t) reader.sched_id;
|
||||
msg.argj = janet_wrap_nil();
|
||||
if (vm) {
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
} else {
|
||||
if (janet_fiber_can_resume(reader.fiber)) {
|
||||
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
||||
@@ -1490,10 +1341,7 @@ const JanetAbstractType janet_channel_type = {
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
janet_chanat_next,
|
||||
NULL, /* call */
|
||||
NULL, /* length */
|
||||
NULL, /* bytes */
|
||||
janet_chanat_gcperthread
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
/* Main event loop */
|
||||
@@ -1526,13 +1374,12 @@ JanetFiber *janet_loop1(void) {
|
||||
}
|
||||
}
|
||||
}
|
||||
handle_timeout_worker(to, 0);
|
||||
}
|
||||
|
||||
/* Run scheduled fibers unless interrupts need to be handled. */
|
||||
while (janet_vm.spawn.head != janet_vm.spawn.tail) {
|
||||
/* Don't run until all interrupts have been marked as handled by calling janet_interpreter_interrupt_handled */
|
||||
if (janet_atomic_load_relaxed(&janet_vm.auto_suspend)) break;
|
||||
if (janet_vm.auto_suspend) break;
|
||||
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
|
||||
janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
|
||||
if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
|
||||
@@ -1574,14 +1421,12 @@ JanetFiber *janet_loop1(void) {
|
||||
while ((has_timeout = peek_timeout(&to))) {
|
||||
if (to.curr_fiber != NULL) {
|
||||
if (!janet_fiber_can_resume(to.curr_fiber)) {
|
||||
pop_timeout(0);
|
||||
janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber));
|
||||
handle_timeout_worker(to, 1);
|
||||
pop_timeout(0);
|
||||
continue;
|
||||
}
|
||||
} else if (to.fiber->sched_id != to.sched_id) {
|
||||
pop_timeout(0);
|
||||
handle_timeout_worker(to, 1);
|
||||
continue;
|
||||
}
|
||||
break;
|
||||
@@ -1746,7 +1591,7 @@ void janet_stream_level_triggered(JanetStream *stream) {
|
||||
|
||||
static JanetTimestamp ts_now(void) {
|
||||
struct timespec now;
|
||||
janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time");
|
||||
janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time");
|
||||
uint64_t res = 1000 * now.tv_sec;
|
||||
res += now.tv_nsec / 1000000;
|
||||
return res;
|
||||
@@ -1904,7 +1749,7 @@ JanetTimestamp to_interval(const JanetTimestamp ts) {
|
||||
|
||||
static JanetTimestamp ts_now(void) {
|
||||
struct timespec now;
|
||||
janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time");
|
||||
janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time");
|
||||
uint64_t res = 1000 * now.tv_sec;
|
||||
res += now.tv_nsec / 1000000;
|
||||
return res;
|
||||
@@ -1944,22 +1789,6 @@ void janet_stream_edge_triggered(JanetStream *stream) {
|
||||
}
|
||||
|
||||
void janet_stream_level_triggered(JanetStream *stream) {
|
||||
/* On macos, we seem to need to delete any registered events before re-registering without
|
||||
* EV_CLEAR, otherwise the new event will still have EV_CLEAR set erroneously. This could be a
|
||||
* kernel bug, but unfortunately the specification is vague here, esp. in regards to where and when
|
||||
* EV_CLEAR is set automatically. */
|
||||
struct kevent kevs[2];
|
||||
int length = 0;
|
||||
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
|
||||
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_DELETE, 0, 0, stream);
|
||||
}
|
||||
if (stream->flags & JANET_STREAM_WRITABLE) {
|
||||
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_DELETE, 0, 0, stream);
|
||||
}
|
||||
int status;
|
||||
do {
|
||||
status = kevent(janet_vm.kq, kevs, length, NULL, 0, NULL);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
janet_register_stream_impl(stream, 0);
|
||||
}
|
||||
|
||||
@@ -2058,7 +1887,7 @@ void janet_ev_deinit(void) {
|
||||
|
||||
static JanetTimestamp ts_now(void) {
|
||||
struct timespec now;
|
||||
janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time");
|
||||
janet_assert(-1 != clock_gettime(CLOCK_REALTIME, &now), "failed to get time");
|
||||
uint64_t res = 1000 * now.tv_sec;
|
||||
res += now.tv_nsec / 1000000;
|
||||
return res;
|
||||
@@ -2230,7 +2059,7 @@ void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage ms
|
||||
event.cb = cb;
|
||||
int fd = vm->selfpipe[1];
|
||||
/* handle a bit of back pressure before giving up. */
|
||||
int tries = 20;
|
||||
int tries = 4;
|
||||
while (tries > 0) {
|
||||
int status;
|
||||
do {
|
||||
@@ -3077,8 +2906,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
uint32_t count1;
|
||||
memcpy(&count1, nextbytes, sizeof(count1));
|
||||
size_t count = (size_t) count1;
|
||||
/* Use division to avoid overflowing size_t */
|
||||
if (count > (endbytes - nextbytes - sizeof(count1)) / sizeof(JanetCFunRegistry)) {
|
||||
if (count > (endbytes - nextbytes) * sizeof(JanetCFunRegistry)) {
|
||||
janet_panic("thread message invalid");
|
||||
}
|
||||
janet_vm.registry_count = count;
|
||||
@@ -3236,7 +3064,6 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
|
||||
to.is_error = 0;
|
||||
to.sched_id = to.fiber->sched_id;
|
||||
to.curr_fiber = NULL;
|
||||
to.has_worker = 0;
|
||||
add_timeout(to);
|
||||
janet_await();
|
||||
}
|
||||
@@ -3250,66 +3077,26 @@ JANET_CORE_FN(cfun_ev_sleep,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ev_deadline,
|
||||
"(ev/deadline sec &opt tocancel tocheck intr?)",
|
||||
"Schedules the event loop to try to cancel the `tocancel` task as with `ev/cancel`. "
|
||||
"After `sec` seconds, the event loop will attempt cancellation of `tocancel` if the "
|
||||
"`tocheck` fiber is resumable. `sec` is a number that can have a fractional part. "
|
||||
"`tocancel` defaults to `(fiber/root)`, but if specified, must be a task (root "
|
||||
"fiber). `tocheck` defaults to `(fiber/current)`, but if specified, must be a fiber. "
|
||||
"Returns `tocancel` immediately. If `interrupt?` is set to true, will create a "
|
||||
"background thread to try to interrupt the VM if the timeout expires.") {
|
||||
janet_arity(argc, 1, 4);
|
||||
"(ev/deadline sec &opt tocancel tocheck)",
|
||||
"Schedules the event loop to try to cancel the `tocancel` "
|
||||
"task as with `ev/cancel`. After `sec` seconds, the event "
|
||||
"loop will attempt cancellation of `tocancel` if the "
|
||||
"`tocheck` fiber is resumable. `sec` is a number that can "
|
||||
"have a fractional part. `tocancel` defaults to "
|
||||
"`(fiber/root)`, but if specified, must be a task (root "
|
||||
"fiber). `tocheck` defaults to `(fiber/current)`, but if "
|
||||
"specified, should be a fiber. Returns `tocancel` "
|
||||
"immediately.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
double sec = janet_getnumber(argv, 0);
|
||||
sec = (sec < 0) ? 0 : sec;
|
||||
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber);
|
||||
JanetFiber *tocheck = janet_optfiber(argv, argc, 2, janet_vm.fiber);
|
||||
int use_interrupt = janet_optboolean(argv, argc, 3, 0);
|
||||
JanetTimeout to;
|
||||
to.when = ts_delta(ts_now(), sec);
|
||||
to.fiber = tocancel;
|
||||
to.curr_fiber = tocheck;
|
||||
to.is_error = 0;
|
||||
to.sched_id = to.fiber->sched_id;
|
||||
if (use_interrupt) {
|
||||
#ifdef JANET_ANDROID
|
||||
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
|
||||
#endif
|
||||
JanetThreadedTimeout *tto = janet_malloc(sizeof(JanetThreadedTimeout));
|
||||
if (NULL == tto) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
tto->sec = sec;
|
||||
tto->vm = &janet_vm;
|
||||
tto->fiber = tocheck;
|
||||
#ifdef JANET_WINDOWS
|
||||
HANDLE cancel_event = CreateEvent(NULL, TRUE, FALSE, NULL);
|
||||
if (NULL == cancel_event) {
|
||||
janet_free(tto);
|
||||
janet_panic("failed to create cancel event");
|
||||
}
|
||||
tto->cancel_event = cancel_event;
|
||||
HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, CREATE_SUSPENDED, NULL);
|
||||
if (NULL == worker) {
|
||||
janet_free(tto);
|
||||
janet_panic("failed to create thread");
|
||||
}
|
||||
#else
|
||||
pthread_t worker;
|
||||
int err = pthread_create(&worker, NULL, janet_timeout_body, tto);
|
||||
if (err) {
|
||||
janet_free(tto);
|
||||
janet_panicf("%s", janet_strerror(err));
|
||||
}
|
||||
#endif
|
||||
to.has_worker = 1;
|
||||
to.worker = worker;
|
||||
#ifdef JANET_WINDOWS
|
||||
to.worker_event = cancel_event;
|
||||
ResumeThread(worker);
|
||||
#endif
|
||||
} else {
|
||||
to.has_worker = 0;
|
||||
}
|
||||
add_timeout(to);
|
||||
return janet_wrap_fiber(tocancel);
|
||||
}
|
||||
@@ -3601,6 +3388,8 @@ void janet_lib_ev(JanetTable *env) {
|
||||
janet_register_abstract_type(&janet_channel_type);
|
||||
janet_register_abstract_type(&janet_mutex_type);
|
||||
janet_register_abstract_type(&janet_rwlock_type);
|
||||
|
||||
janet_lib_filewatch(env);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -1686,7 +1686,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
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, buffer->count);
|
||||
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;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -599,33 +599,33 @@ JANET_CORE_FN(cfun_filewatch_make,
|
||||
JANET_CORE_FN(cfun_filewatch_add,
|
||||
"(filewatch/add watcher path &opt flags)",
|
||||
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
|
||||
"Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
|
||||
"Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n"
|
||||
"* `:all` - trigger an event for all of the below triggers.\n\n"
|
||||
"* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n"
|
||||
"* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n"
|
||||
"* `:dir-name` - `FILE_NOTIFY_CHANGE_DIR_NAME`\n\n"
|
||||
"* `:last-access` - `FILE_NOTIFY_CHANGE_LAST_ACCESS`\n\n"
|
||||
"* `:last-write` - `FILE_NOTIFY_CHANGE_LAST_WRITE`\n\n"
|
||||
"* `:security` - `FILE_NOTIFY_CHANGE_SECURITY`\n\n"
|
||||
"* `:size` - `FILE_NOTIFY_CHANGE_SIZE`\n\n"
|
||||
"* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
|
||||
"* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
|
||||
"* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
|
||||
"* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
|
||||
"* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
|
||||
"* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
|
||||
"* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
|
||||
"* `:recursive` - watch subdirectories recursively\n\n"
|
||||
"Linux (flags correspond to `IN_*` flags from <sys/inotify.h>):\n\n"
|
||||
"* `:access` - `IN_ACCESS`\n\n"
|
||||
"* `:all` - `IN_ALL_EVENTS`\n\n"
|
||||
"* `:attrib` - `IN_ATTRIB`\n\n"
|
||||
"* `:close-nowrite` - `IN_CLOSE_NOWRITE`\n\n"
|
||||
"* `:close-write` - `IN_CLOSE_WRITE`\n\n"
|
||||
"* `:create` - `IN_CREATE`\n\n"
|
||||
"* `:delete` - `IN_DELETE`\n\n"
|
||||
"* `:delete-self` - `IN_DELETE_SELF`\n\n"
|
||||
"* `:ignored` - `IN_IGNORED`\n\n"
|
||||
"* `:modify` - `IN_MODIFY`\n\n"
|
||||
"* `:move-self` - `IN_MOVE_SELF`\n\n"
|
||||
"* `:moved-from` - `IN_MOVED_FROM`\n\n"
|
||||
"* `:moved-to` - `IN_MOVED_TO`\n\n"
|
||||
"* `:open` - `IN_OPEN`\n\n"
|
||||
"* `:q-overflow` - `IN_Q_OVERFLOW`\n\n"
|
||||
"* `:unmount` - `IN_UNMOUNT`\n\n\n"
|
||||
"Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
|
||||
"* `:access` - IN_ACCESS\n\n"
|
||||
"* `:all` - IN_ALL_EVENTS\n\n"
|
||||
"* `:attrib` - IN_ATTRIB\n\n"
|
||||
"* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
|
||||
"* `:close-write` - IN_CLOSE_WRITE\n\n"
|
||||
"* `:create` - IN_CREATE\n\n"
|
||||
"* `:delete` - IN_DELETE\n\n"
|
||||
"* `:delete-self` - IN_DELETE_SELF\n\n"
|
||||
"* `:ignored` - IN_IGNORED\n\n"
|
||||
"* `:modify` - IN_MODIFY\n\n"
|
||||
"* `:move-self` - IN_MOVE_SELF\n\n"
|
||||
"* `:moved-from` - IN_MOVED_FROM\n\n"
|
||||
"* `:moved-to` - IN_MOVED_TO\n\n"
|
||||
"* `:open` - IN_OPEN\n\n"
|
||||
"* `:q-overflow` - IN_Q_OVERFLOW\n\n"
|
||||
"* `:unmount` - IN_UNMOUNT\n\n\n"
|
||||
"On Windows, events will have the following possible types:\n\n"
|
||||
"* `:unknown`\n\n"
|
||||
"* `:added`\n\n"
|
||||
@@ -633,7 +633,7 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"* `:modified`\n\n"
|
||||
"* `:renamed-old`\n\n"
|
||||
"* `:renamed-new`\n\n"
|
||||
"On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
||||
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
||||
"") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark only the keys from a sequence of key-value pairs */
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
@@ -141,7 +141,7 @@ static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark only the values from a sequence of key-value pairs */
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
@@ -150,7 +150,7 @@ static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark key-value pairs */
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
@@ -346,9 +346,6 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
break;
|
||||
case JANET_MEMORY_ABSTRACT: {
|
||||
JanetAbstractHead *head = (JanetAbstractHead *)mem;
|
||||
if (head->type->gcperthread) {
|
||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||
}
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
@@ -500,12 +497,9 @@ void janet_sweep() {
|
||||
/* If not visited... */
|
||||
if (!janet_truthy(items[i].value)) {
|
||||
void *abst = janet_unwrap_abstract(items[i].key);
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gcperthread) {
|
||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||
}
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
/* Run finalizer */
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
@@ -678,11 +672,8 @@ void janet_clear_memory(void) {
|
||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(items[i].key);
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gcperthread) {
|
||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||
}
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose & contributors
|
||||
* Copyright (c) 2024 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
|
||||
@@ -191,21 +191,21 @@ Janet janet_wrap_u64(uint64_t x) {
|
||||
|
||||
JANET_CORE_FN(cfun_it_s64_new,
|
||||
"(int/s64 value)",
|
||||
"Create a boxed signed 64 bit integer from a string value or a number.") {
|
||||
"Create a boxed signed 64 bit integer from a string value.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_it_u64_new,
|
||||
"(int/u64 value)",
|
||||
"Create a boxed unsigned 64 bit integer from a string value or a number.") {
|
||||
"Create a boxed unsigned 64 bit integer from a string value.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_to_number,
|
||||
"(int/to-number value)",
|
||||
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int64.") {
|
||||
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_type(argv[0]) == JANET_ABSTRACT) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
|
||||
127
src/core/net.c
127
src/core/net.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose and contributors.
|
||||
* Copyright (c) 2024 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
|
||||
@@ -341,7 +341,7 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
||||
/* Needs argc >= offset + 2 */
|
||||
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
|
||||
* otherwise 0. Also, ignores is_bind when is a unix socket. */
|
||||
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix, socklen_t *sizeout) {
|
||||
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
|
||||
/* Unix socket support - not yet supported on windows. */
|
||||
#ifndef JANET_WINDOWS
|
||||
if (janet_keyeq(argv[offset], "unix")) {
|
||||
@@ -352,14 +352,15 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
||||
}
|
||||
saddr->sun_family = AF_UNIX;
|
||||
size_t path_size = sizeof(saddr->sun_path);
|
||||
snprintf(saddr->sun_path, path_size, "%s", path);
|
||||
*sizeout = sizeof(struct sockaddr_un);
|
||||
#ifdef JANET_LINUX
|
||||
if (path[0] == '@') {
|
||||
saddr->sun_path[0] = '\0';
|
||||
*sizeout = offsetof(struct sockaddr_un, sun_path) + janet_string_length(path);
|
||||
}
|
||||
snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
snprintf(saddr->sun_path, path_size, "%s", path);
|
||||
}
|
||||
*is_unix = 1;
|
||||
return (struct addrinfo *) saddr;
|
||||
}
|
||||
@@ -384,11 +385,6 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||
}
|
||||
*is_unix = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
*sizeout = 0;
|
||||
#else
|
||||
*sizeout = sizeof(struct sockaddr_un);
|
||||
#endif
|
||||
return ai;
|
||||
}
|
||||
|
||||
@@ -409,13 +405,12 @@ JANET_CORE_FN(cfun_net_sockaddr,
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
int make_arr = (argc >= 3 && janet_truthy(argv[3]));
|
||||
socklen_t addrsize = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix, &addrsize);
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||
#ifndef JANET_WINDOWS
|
||||
/* no unix domain socket support on windows yet */
|
||||
if (is_unix) {
|
||||
void *abst = janet_abstract(&janet_address_type, addrsize);
|
||||
memcpy(abst, ai, addrsize);
|
||||
void *abst = janet_abstract(&janet_address_type, sizeof(struct sockaddr_un));
|
||||
memcpy(abst, ai, sizeof(struct sockaddr_un));
|
||||
Janet ret = janet_wrap_abstract(abst);
|
||||
return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret;
|
||||
}
|
||||
@@ -466,8 +461,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
}
|
||||
|
||||
/* Where we're connecting to */
|
||||
socklen_t addrlen = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix, &addrlen);
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||
|
||||
/* Check if we're binding address */
|
||||
struct addrinfo *binding = NULL;
|
||||
@@ -492,6 +486,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
/* Create socket */
|
||||
JSock sock = JSOCKDEFAULT;
|
||||
void *addr = NULL;
|
||||
socklen_t addrlen = 0;
|
||||
#ifndef JANET_WINDOWS
|
||||
if (is_unix) {
|
||||
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
@@ -501,6 +496,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
janet_panicf("could not create socket: %V", v);
|
||||
}
|
||||
addr = (void *) ai;
|
||||
addrlen = sizeof(struct sockaddr_un);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
@@ -547,9 +543,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
}
|
||||
|
||||
/* Wrap socket in abstract type JanetStream */
|
||||
uint32_t udp_flag = 0;
|
||||
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
|
||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
|
||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
|
||||
/* Set up the socket for non-blocking IO before connecting */
|
||||
janet_net_socknoblock(sock);
|
||||
@@ -560,10 +554,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
int err = WSAGetLastError();
|
||||
freeaddrinfo(ai);
|
||||
#else
|
||||
int status;
|
||||
do {
|
||||
status = connect(sock, addr, addrlen);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
int status = connect(sock, addr, addrlen);
|
||||
int err = errno;
|
||||
if (is_unix) {
|
||||
janet_free(ai);
|
||||
@@ -587,73 +578,17 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
net_sched_connect(stream);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_socket,
|
||||
"(net/socket &opt type)",
|
||||
"Creates a new unbound socket. Type is an optional keyword, "
|
||||
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
|
||||
int socktype = janet_get_sockettype(argv, argc, 0);
|
||||
|
||||
/* Create socket */
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
struct addrinfo *ai = NULL;
|
||||
struct addrinfo hints;
|
||||
memset(&hints, 0, sizeof(hints));
|
||||
hints.ai_family = AF_UNSPEC;
|
||||
hints.ai_socktype = socktype;
|
||||
hints.ai_flags = 0;
|
||||
int status = getaddrinfo(NULL, "0", &hints, &ai);
|
||||
if (status) {
|
||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||
}
|
||||
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
#ifdef JANET_WINDOWS
|
||||
sfd = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||
#else
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
#endif
|
||||
if (JSOCKVALID(sfd)) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
freeaddrinfo(ai);
|
||||
|
||||
if (!JSOCKVALID(sfd)) {
|
||||
Janet v = janet_ev_lasterr();
|
||||
janet_panicf("could not create socket: %V", v);
|
||||
}
|
||||
|
||||
/* Wrap socket in abstract type JanetStream */
|
||||
uint32_t udp_flag = 0;
|
||||
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
|
||||
JanetStream *stream = make_stream(sfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
|
||||
|
||||
/* Set up the socket for non-blocking IO */
|
||||
janet_net_socknoblock(sfd);
|
||||
|
||||
return janet_wrap_abstract(stream);
|
||||
}
|
||||
|
||||
static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) {
|
||||
static const char *serverify_socket(JSock sfd) {
|
||||
/* Set various socket options */
|
||||
int enable = 1;
|
||||
if (reuse_addr) {
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEADDR) failed";
|
||||
}
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEADDR) failed";
|
||||
}
|
||||
if (reuse_port) {
|
||||
#ifdef SO_REUSEPORT
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEPORT) failed";
|
||||
}
|
||||
#else
|
||||
(void) reuse_port;
|
||||
#endif
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEPORT) failed";
|
||||
}
|
||||
#endif
|
||||
janet_net_socknoblock(sfd);
|
||||
return NULL;
|
||||
}
|
||||
@@ -707,22 +642,19 @@ JANET_CORE_FN(cfun_net_shutdown,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_listen,
|
||||
"(net/listen host port &opt type no-reuse)",
|
||||
"(net/listen host port &opt type)",
|
||||
"Creates a server. Returns a new stream that is neither readable nor "
|
||||
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
|
||||
"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. The last boolean parameter `no-reuse` will "
|
||||
"disable the use of `SO_REUSEADDR` and `SO_REUSEPORT` when creating a server on some operating systems.") {
|
||||
":stream. The host and port arguments are the same as in net/address.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
|
||||
janet_arity(argc, 2, 4);
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
socklen_t addrlen = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix, &addrlen);
|
||||
int reuse = !(argc >= 4 && janet_truthy(argv[3]));
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
|
||||
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
#ifndef JANET_WINDOWS
|
||||
@@ -732,8 +664,8 @@ JANET_CORE_FN(cfun_net_listen,
|
||||
janet_free(ai);
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
const char *err = serverify_socket(sfd, reuse, 0);
|
||||
if (NULL != err || bind(sfd, (struct sockaddr *)ai, addrlen)) {
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_free(ai);
|
||||
if (err) {
|
||||
@@ -755,7 +687,7 @@ JANET_CORE_FN(cfun_net_listen,
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
#endif
|
||||
if (!JSOCKVALID(sfd)) continue;
|
||||
const char *err = serverify_socket(sfd, reuse, reuse);
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err) {
|
||||
JSOCKCLOSE(sfd);
|
||||
continue;
|
||||
@@ -1021,7 +953,6 @@ struct sockopt_type {
|
||||
/* List of supported socket options; The type JANET_POINTER is used
|
||||
* for options that require special handling depending on the type. */
|
||||
static const struct sockopt_type sockopt_type_list[] = {
|
||||
{ "tcp-nodelay", IPPROTO_TCP, TCP_NODELAY, JANET_BOOLEAN },
|
||||
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
|
||||
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
|
||||
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
|
||||
@@ -1043,7 +974,6 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
||||
"- :so-broadcast boolean\n"
|
||||
"- :so-reuseaddr boolean\n"
|
||||
"- :so-keepalive boolean\n"
|
||||
"- :tcp-nodelay boolean\n"
|
||||
"- :ip-multicast-ttl number\n"
|
||||
"- :ip-add-membership string\n"
|
||||
"- :ip-drop-membership string\n"
|
||||
@@ -1137,7 +1067,6 @@ void janet_lib_net(JanetTable *env) {
|
||||
JanetRegExt net_cfuns[] = {
|
||||
JANET_CORE_REG("net/address", cfun_net_sockaddr),
|
||||
JANET_CORE_REG("net/listen", cfun_net_listen),
|
||||
JANET_CORE_REG("net/socket", cfun_net_socket),
|
||||
JANET_CORE_REG("net/accept", cfun_stream_accept),
|
||||
JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop),
|
||||
JANET_CORE_REG("net/read", cfun_stream_read),
|
||||
|
||||
241
src/core/os.c
241
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose and contributors.
|
||||
* Copyright (c) 2024 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
|
||||
@@ -55,7 +55,6 @@
|
||||
#include <sys/utime.h>
|
||||
#include <io.h>
|
||||
#include <process.h>
|
||||
#define JANET_SPAWN_CHDIR
|
||||
#else
|
||||
#include <spawn.h>
|
||||
#include <utime.h>
|
||||
@@ -66,8 +65,6 @@
|
||||
#ifdef JANET_APPLE
|
||||
#include <crt_externs.h>
|
||||
#define environ (*_NSGetEnviron())
|
||||
#include <AvailabilityMacros.h>
|
||||
int chroot(const char *dirname);
|
||||
#else
|
||||
extern char **environ;
|
||||
#endif
|
||||
@@ -76,26 +73,6 @@ extern char **environ;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Detect availability of posix_spawn_file_actions_addchdir_np. Since
|
||||
* this doesn't seem to follow any standard, just a common extension, we
|
||||
* must enumerate supported systems for availability. Define JANET_SPAWN_NO_CHDIR
|
||||
* to disable this. */
|
||||
#ifndef JANET_SPAWN_NO_CHDIR
|
||||
#ifdef __GLIBC__
|
||||
#define JANET_SPAWN_CHDIR
|
||||
#elif defined(JANET_APPLE)
|
||||
/* The posix_spawn_file_actions_addchdir_np function
|
||||
* has only been implemented since macOS 10.15 */
|
||||
#if defined(MAC_OS_X_VERSION_10_15) && (MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_15)
|
||||
#define JANET_SPAWN_CHDIR
|
||||
#else
|
||||
#define JANET_SPAWN_NO_CHDIR
|
||||
#endif
|
||||
#elif defined(__FreeBSD__) /* Not all BSDs work, for example openBSD doesn't seem to support this */
|
||||
#define JANET_SPAWN_CHDIR
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Not POSIX, but all Unixes but Solaris have this function. */
|
||||
#if defined(JANET_POSIX) && !defined(__sun)
|
||||
time_t timegm(struct tm *tm);
|
||||
@@ -181,8 +158,6 @@ JANET_CORE_FN(os_which,
|
||||
return janet_ckeywordv("dragonfly");
|
||||
#elif defined(JANET_BSD)
|
||||
return janet_ckeywordv("bsd");
|
||||
#elif defined(JANET_ILLUMOS)
|
||||
return janet_ckeywordv("illumos");
|
||||
#else
|
||||
return janet_ckeywordv("posix");
|
||||
#endif
|
||||
@@ -322,13 +297,6 @@ JANET_CORE_FN(os_cpu_count,
|
||||
return dflt;
|
||||
}
|
||||
return janet_wrap_integer(result);
|
||||
#elif defined(JANET_ILLUMOS)
|
||||
(void) dflt;
|
||||
long result = sysconf(_SC_NPROCESSORS_CONF);
|
||||
if (result < 0) {
|
||||
return dflt;
|
||||
}
|
||||
return janet_wrap_integer(result);
|
||||
#else
|
||||
return dflt;
|
||||
#endif
|
||||
@@ -573,12 +541,11 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
proc->flags &= ~JANET_PROC_WAITING;
|
||||
janet_gcunroot(janet_wrap_abstract(proc));
|
||||
janet_gcunroot(janet_wrap_fiber(args.fiber));
|
||||
uint32_t sched_id = (uint32_t) args.argi;
|
||||
if (janet_fiber_can_resume(args.fiber) && args.fiber->sched_id == sched_id) {
|
||||
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
|
||||
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
||||
janet_cancel(args.fiber, janet_wrap_string(s));
|
||||
} else {
|
||||
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
|
||||
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
||||
janet_cancel(args.fiber, janet_wrap_string(s));
|
||||
} else {
|
||||
if (janet_fiber_can_resume(args.fiber)) {
|
||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||
}
|
||||
}
|
||||
@@ -636,7 +603,6 @@ os_proc_wait_impl(JanetProc *proc) {
|
||||
memset(&targs, 0, sizeof(targs));
|
||||
targs.argp = proc;
|
||||
targs.fiber = janet_root_fiber();
|
||||
targs.argi = (uint32_t) targs.fiber->sched_id;
|
||||
janet_gcroot(janet_wrap_abstract(proc));
|
||||
janet_gcroot(janet_wrap_fiber(targs.fiber));
|
||||
janet_ev_threaded_call(janet_proc_wait_subr, targs, janet_proc_wait_cb);
|
||||
@@ -663,15 +629,16 @@ os_proc_wait_impl(JanetProc *proc) {
|
||||
|
||||
JANET_CORE_FN(os_proc_wait,
|
||||
"(os/proc-wait proc)",
|
||||
"Suspend the current fiber until the subprocess `proc` completes. Once `proc` "
|
||||
"completes, return the exit code of `proc`. If called more than once on the same "
|
||||
"core/process value, will raise an error. When creating subprocesses using "
|
||||
"`os/spawn`, this function should be called on the returned value to avoid zombie "
|
||||
"processes.") {
|
||||
"Suspend the current fiber until the subprocess completes. Returns the subprocess return code. "
|
||||
"os/proc-wait cannot be called twice on the same process. If `ev/with-deadline` cancels `os/proc-wait` "
|
||||
"with an error or os/proc-wait is cancelled with any error caused by anything else, os/proc-wait still "
|
||||
"finishes in the background. Only after os/proc-wait finishes, a process is cleaned up by the operating "
|
||||
"system. Thus, a process becomes a zombie process if os/proc-wait is not called.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
@@ -776,13 +743,12 @@ static int get_signal_kw(const Janet *argv, int32_t n) {
|
||||
|
||||
JANET_CORE_FN(os_proc_kill,
|
||||
"(os/proc-kill proc &opt wait signal)",
|
||||
"Kill the subprocess `proc` by sending SIGKILL to it on POSIX systems, or by closing "
|
||||
"the process handle on Windows. If `proc` has already completed, raise an error. If "
|
||||
"`wait` is truthy, will wait for `proc` to complete and return the exit code (this "
|
||||
"will raise an error if `proc` is being waited for). Otherwise, return `proc`. If "
|
||||
"`signal` is provided, send it instead of SIGKILL. Signal keywords are named after "
|
||||
"their C counterparts but in lowercase with the leading SIG stripped. `signal` is "
|
||||
"ignored on Windows.") {
|
||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||
"handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After "
|
||||
"sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit "
|
||||
"code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. "
|
||||
"Signal keywords are named after their C counterparts but in lowercase with the leading `SIG` stripped. "
|
||||
"Signals are ignored on windows.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
@@ -810,6 +776,7 @@ JANET_CORE_FN(os_proc_kill,
|
||||
if (argc > 1 && janet_truthy(argv[1])) {
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
@@ -820,9 +787,9 @@ JANET_CORE_FN(os_proc_kill,
|
||||
|
||||
JANET_CORE_FN(os_proc_close,
|
||||
"(os/proc-close proc)",
|
||||
"Close pipes created for subprocess `proc` by `os/spawn` if they have not been "
|
||||
"closed. Then, if `proc` is not being waited for, wait. If this function waits, when "
|
||||
"`proc` completes, return the exit code of `proc`. Otherwise, return nil.") {
|
||||
"Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already "
|
||||
"called on proc, os/proc-wait is called on it, and it returns the exit code returned by os/proc-wait. "
|
||||
"Otherwise, returns nil.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
@@ -840,24 +807,12 @@ JANET_CORE_FN(os_proc_close,
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_proc_getpid,
|
||||
"(os/getpid)",
|
||||
"Get the process ID of the current process.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
return janet_wrap_number((double) _getpid());
|
||||
#else
|
||||
return janet_wrap_number((double) getpid());
|
||||
#endif
|
||||
}
|
||||
|
||||
static void swap_handles(JanetHandle *handles) {
|
||||
JanetHandle temp = handles[0];
|
||||
handles[0] = handles[1];
|
||||
@@ -1182,7 +1137,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
JanetAbstract orig_in = NULL, orig_out = NULL, orig_err = NULL;
|
||||
JanetHandle new_in = JANET_HANDLE_NONE, new_out = JANET_HANDLE_NONE, new_err = JANET_HANDLE_NONE;
|
||||
JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE;
|
||||
int stderr_is_stdout = 0;
|
||||
int pipe_errflag = 0; /* Track errors setting up pipes */
|
||||
int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
|
||||
|
||||
@@ -1207,28 +1161,11 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
|
||||
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
|
||||
} else if (is_spawn && janet_keyeq(maybe_stderr, "out")) {
|
||||
stderr_is_stdout = 1;
|
||||
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
||||
new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
|
||||
}
|
||||
}
|
||||
|
||||
/* Optional working directory. Available for both os/execute and os/spawn. */
|
||||
const char *chdir_path = NULL;
|
||||
if (argc > 2) {
|
||||
JanetDictView tab = janet_getdictionary(argv, 2);
|
||||
Janet workdir = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("cd"));
|
||||
if (janet_checktype(workdir, JANET_STRING)) {
|
||||
chdir_path = (const char *) janet_unwrap_string(workdir);
|
||||
#ifndef JANET_SPAWN_CHDIR
|
||||
janet_panicf(":cd argument not supported on this system - %s", chdir_path);
|
||||
#endif
|
||||
} else if (!janet_checktype(workdir, JANET_NIL)) {
|
||||
janet_panicf("expected string for :cd argumnet, got %v", workdir);
|
||||
}
|
||||
}
|
||||
|
||||
/* Clean up if any of the pipes have any issues */
|
||||
if (pipe_errflag) {
|
||||
if (pipe_in != JANET_HANDLE_NONE) close_handle(pipe_in);
|
||||
@@ -1243,7 +1180,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
PROCESS_INFORMATION processInfo;
|
||||
STARTUPINFO startupInfo;
|
||||
LPCSTR lpCurrentDirectory = NULL;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
memset(&processInfo, 0, sizeof(processInfo));
|
||||
memset(&startupInfo, 0, sizeof(startupInfo));
|
||||
@@ -1260,10 +1196,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
}
|
||||
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||
|
||||
if (chdir_path != NULL) {
|
||||
lpCurrentDirectory = chdir_path;
|
||||
}
|
||||
|
||||
/* Do IO redirection */
|
||||
|
||||
if (pipe_in != JANET_HANDLE_NONE) {
|
||||
@@ -1271,7 +1203,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
} else if (new_in != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdInput = new_in;
|
||||
} else {
|
||||
startupInfo.hStdInput = (HANDLE) _get_osfhandle(_fileno(stdin));
|
||||
startupInfo.hStdInput = (HANDLE) _get_osfhandle(0);
|
||||
}
|
||||
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
@@ -1279,17 +1211,15 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
} else if (new_out != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdOutput = new_out;
|
||||
} else {
|
||||
startupInfo.hStdOutput = (HANDLE) _get_osfhandle(_fileno(stdout));
|
||||
startupInfo.hStdOutput = (HANDLE) _get_osfhandle(1);
|
||||
}
|
||||
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdError = pipe_err;
|
||||
} else if (new_err != NULL) {
|
||||
startupInfo.hStdError = new_err;
|
||||
} else if (stderr_is_stdout) {
|
||||
startupInfo.hStdError = startupInfo.hStdOutput;
|
||||
} else {
|
||||
startupInfo.hStdError = (HANDLE) _get_osfhandle(_fileno(stderr));
|
||||
startupInfo.hStdError = (HANDLE) _get_osfhandle(2);
|
||||
}
|
||||
|
||||
int cp_failed = 0;
|
||||
@@ -1300,7 +1230,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
TRUE, /* handle inheritance */
|
||||
0, /* flags */
|
||||
use_environ ? NULL : envp, /* pass in environment */
|
||||
lpCurrentDirectory,
|
||||
NULL, /* use parents starting directory */
|
||||
&startupInfo,
|
||||
&processInfo)) {
|
||||
cp_failed = 1;
|
||||
@@ -1338,6 +1268,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
|
||||
/* exec mode */
|
||||
if (mode == JANET_EXECUTE_EXEC) {
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported on windows");
|
||||
#else
|
||||
int status;
|
||||
if (!use_environ) {
|
||||
environ = envp;
|
||||
@@ -1350,6 +1283,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
}
|
||||
} while (status == -1 && errno == EINTR);
|
||||
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
@@ -1357,15 +1291,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
/* Posix spawn setup */
|
||||
posix_spawn_file_actions_t actions;
|
||||
posix_spawn_file_actions_init(&actions);
|
||||
#ifdef JANET_SPAWN_CHDIR
|
||||
if (chdir_path != NULL) {
|
||||
#ifdef JANET_SPAWN_CHDIR_NO_NP
|
||||
posix_spawn_file_actions_addchdir(&actions, chdir_path);
|
||||
#else
|
||||
posix_spawn_file_actions_addchdir_np(&actions, chdir_path);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
if (pipe_in != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_in);
|
||||
@@ -1388,8 +1313,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
} else if (new_err != JANET_HANDLE_NONE && new_err != 2) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_err, 2);
|
||||
posix_spawn_file_actions_addclose(&actions, new_err);
|
||||
} else if (stderr_is_stdout) {
|
||||
posix_spawn_file_actions_adddup2(&actions, 1, 2);
|
||||
}
|
||||
|
||||
pid_t pid;
|
||||
@@ -1461,57 +1384,45 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
|
||||
JANET_CORE_FN(os_execute,
|
||||
"(os/execute args &opt flags env)",
|
||||
"Execute a program on the system and return the exit code. `args` is an array/tuple "
|
||||
"of strings. The first string is the name of the program and the remainder are "
|
||||
"arguments passed to the program. `flags` is a keyword made from the following "
|
||||
"characters that modifies how the program executes:\n"
|
||||
"* :e - enables passing an environment to the program. Without 'e', the "
|
||||
"Execute a program on the system and pass it string arguments. `flags` "
|
||||
"is a keyword that modifies how the program will execute.\n"
|
||||
"* :e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n"
|
||||
"* :p - allows searching the current PATH for the program to execute. "
|
||||
"Without this flag, the first element of `args` must be an absolute path.\n"
|
||||
"* :x - raises error if exit code is non-zero.\n"
|
||||
"* :d - prevents the garbage collector terminating the program (if still running) "
|
||||
"and calling the equivalent of `os/proc-wait` (allows zombie processes).\n"
|
||||
"`env` is a table/struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the "
|
||||
"subprocess. :in, :out, and :err should be core/file or core/stream values. "
|
||||
"If core/stream values are used, the caller is responsible for ensuring pipes do not "
|
||||
"cause the program to block and deadlock.") {
|
||||
"* :p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n"
|
||||
"* :x - raise error if exit code is non-zero.\n"
|
||||
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
|
||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
|
||||
"values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. "
|
||||
"Returns the exit code of the program.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_spawn,
|
||||
"(os/spawn args &opt flags env)",
|
||||
"Execute a program on the system and return a core/process value representing the "
|
||||
"spawned subprocess. Takes the same arguments as `os/execute` but does not wait for "
|
||||
"the subprocess to complete. Unlike `os/execute`, the value `:pipe` can be used for "
|
||||
":in, :out and :err keys in `env`. If used, the returned core/process will have a "
|
||||
"writable stream in the :in field and readable streams in the :out and :err fields. "
|
||||
"On non-Windows systems, the subprocess PID will be in the :pid field. The caller is "
|
||||
"responsible for waiting on the process (e.g. by calling `os/proc-wait` on the "
|
||||
"returned core/process value) to avoid creating zombie process. After the subprocess "
|
||||
"completes, the exit value is in the :return-code field. If `flags` includes 'x', a "
|
||||
"non-zero exit code will cause a waiting fiber to raise an error. The use of "
|
||||
"`:pipe` may fail if there are too many active file descriptors. The caller is "
|
||||
"responsible for closing pipes created by `:pipe` (either individually or using "
|
||||
"`os/proc-close`). Similar to `os/execute`, the caller is responsible for ensuring "
|
||||
"pipes do not cause the program to block and deadlock. As a special case, the stream passed to `:err` "
|
||||
"can be the keyword `:out` to redirect stderr to stdout in the subprocess.") {
|
||||
"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 "
|
||||
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
|
||||
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
|
||||
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
|
||||
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
|
||||
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
|
||||
"If pipe streams created with :pipe keyword are not closed in time, janet can run out of file "
|
||||
"descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. "
|
||||
"If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the "
|
||||
"process cannot finish because the process cannot print more on pipe buffers which are already full. "
|
||||
"If the process cannot finish, os/proc-wait cannot finish, either.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_exec,
|
||||
"(os/posix-exec args &opt flags env)",
|
||||
"Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. "
|
||||
"However, instead of creating a subprocess, the current process is replaced. Is not supported on Windows, and "
|
||||
"However, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
|
||||
"does not allow redirection of stdio.") {
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
|
||||
#endif
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_fork,
|
||||
@@ -1522,7 +1433,7 @@ JANET_CORE_FN(os_posix_fork,
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported on Windows");
|
||||
janet_panic("not supported");
|
||||
#else
|
||||
pid_t result;
|
||||
do {
|
||||
@@ -1542,27 +1453,6 @@ JANET_CORE_FN(os_posix_fork,
|
||||
#endif
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_chroot,
|
||||
"(os/posix-chroot dirname)",
|
||||
"Call `chroot` to change the root directory to `dirname`. "
|
||||
"Not supported on all systems (POSIX only).") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_CHROOT);
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
const char *root = janet_getcstring(argv, 0);
|
||||
int result;
|
||||
do {
|
||||
result = chroot(root);
|
||||
} while (result == -1 && errno == EINTR);
|
||||
if (result == -1) {
|
||||
janet_panic(janet_strerror(errno));
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
/* Runs in a separate thread */
|
||||
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||
@@ -1990,6 +1880,7 @@ JANET_CORE_FN(os_mktime,
|
||||
/* utc time */
|
||||
#ifdef JANET_NO_UTC_MKTIME
|
||||
janet_panic("os/mktime UTC not supported on this platform");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
t = timegm(&t_info);
|
||||
#endif
|
||||
@@ -2056,7 +1947,8 @@ JANET_CORE_FN(os_link,
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not supported on Windows");
|
||||
janet_panic("os/link not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
@@ -2074,7 +1966,8 @@ JANET_CORE_FN(os_symlink,
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not supported on Windows");
|
||||
janet_panic("os/symlink not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
@@ -2176,7 +2069,8 @@ JANET_CORE_FN(os_readlink,
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not supported on Windows");
|
||||
janet_panic("os/readlink not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
static char buffer[PATH_MAX];
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
@@ -2432,6 +2326,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
return sg->fn(&st);
|
||||
}
|
||||
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2871,7 +2766,6 @@ void janet_lib_os(JanetTable *env) {
|
||||
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/posix-chroot", os_posix_chroot),
|
||||
#ifndef JANET_NO_UMASK
|
||||
JANET_CORE_REG("os/umask", os_umask),
|
||||
#endif
|
||||
@@ -2901,10 +2795,6 @@ void janet_lib_os(JanetTable *env) {
|
||||
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),
|
||||
JANET_CORE_REG("os/getpid", os_proc_getpid),
|
||||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/sigaction", os_sigaction),
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* high resolution timers */
|
||||
@@ -2913,6 +2803,7 @@ void janet_lib_os(JanetTable *env) {
|
||||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/open", os_open), /* fs read and write */
|
||||
JANET_CORE_REG("os/pipe", os_pipe),
|
||||
JANET_CORE_REG("os/sigaction", os_sigaction),
|
||||
#endif
|
||||
#endif
|
||||
JANET_REG_END
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -342,7 +342,7 @@ tail:
|
||||
while (captured < hi) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (!next_text || ((next_text == text) && (hi == UINT32_MAX))) {
|
||||
if (!next_text || next_text == text) {
|
||||
cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
@@ -544,80 +544,41 @@ tail:
|
||||
return window_end;
|
||||
}
|
||||
|
||||
case RULE_TIL: {
|
||||
const uint32_t *rule_terminus = s->bytecode + rule[1];
|
||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
||||
|
||||
const uint8_t *terminus_start = text;
|
||||
const uint8_t *terminus_end = NULL;
|
||||
down1(s);
|
||||
while (terminus_start <= s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
terminus_end = peg_rule(s, rule_terminus, terminus_start);
|
||||
cap_load(s, cs2);
|
||||
if (terminus_end) {
|
||||
break;
|
||||
}
|
||||
terminus_start++;
|
||||
}
|
||||
up1(s);
|
||||
|
||||
if (!terminus_end) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
const uint8_t *saved_end = s->text_end;
|
||||
s->text_end = terminus_start;
|
||||
down1(s);
|
||||
const uint8_t *matched = peg_rule(s, rule_subpattern, text);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
|
||||
if (!matched) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
return terminus_end;
|
||||
}
|
||||
|
||||
case RULE_SPLIT: {
|
||||
const uint8_t *saved_end = s->text_end;
|
||||
const uint32_t *rule_separator = s->bytecode + rule[1];
|
||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
||||
|
||||
const uint8_t *chunk_start = text;
|
||||
const uint8_t *chunk_end = NULL;
|
||||
|
||||
while (text <= saved_end) {
|
||||
/* Find next split (or end of text) */
|
||||
const uint8_t *separator_end = NULL;
|
||||
do {
|
||||
const uint8_t *text_start = text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= saved_end) {
|
||||
chunk_end = text;
|
||||
const uint8_t *check = peg_rule(s, rule_separator, text);
|
||||
while (text <= s->text_end) {
|
||||
separator_end = peg_rule(s, rule_separator, text);
|
||||
cap_load(s, cs);
|
||||
if (check) {
|
||||
text = check;
|
||||
if (separator_end) {
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
|
||||
/* Match between splits */
|
||||
s->text_end = chunk_end;
|
||||
if (separator_end) {
|
||||
s->text_end = text;
|
||||
text = separator_end;
|
||||
}
|
||||
|
||||
down1(s);
|
||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, chunk_start);
|
||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
if (!subpattern_end) return NULL; /* Don't match anything */
|
||||
|
||||
/* Ensure forward progress */
|
||||
if (text == chunk_start) return NULL;
|
||||
chunk_start = text;
|
||||
}
|
||||
if (!subpattern_end) {
|
||||
return NULL;
|
||||
}
|
||||
} while (separator_end);
|
||||
|
||||
s->text_end = saved_end;
|
||||
return s->text_end;
|
||||
}
|
||||
|
||||
@@ -1266,14 +1227,6 @@ static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_2(r, RULE_SUB, subrule1, subrule2);
|
||||
}
|
||||
|
||||
static void spec_til(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t subrule1 = peg_compile1(b, argv[0]);
|
||||
uint32_t subrule2 = peg_compile1(b, argv[1]);
|
||||
emit_2(r, RULE_TIL, subrule1, subrule2);
|
||||
}
|
||||
|
||||
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
@@ -1370,7 +1323,6 @@ static const SpecialPair peg_specials[] = {
|
||||
{"split", spec_split},
|
||||
{"sub", spec_sub},
|
||||
{"thru", spec_thru},
|
||||
{"til", spec_til},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
{"uint-be", spec_uint_be},
|
||||
@@ -1464,11 +1416,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
emit_bytes(b, RULE_LITERAL, len, str);
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER: {
|
||||
const JanetBuffer *buf = janet_unwrap_buffer(peg);
|
||||
emit_bytes(b, RULE_LITERAL, buf->count, buf->data);
|
||||
break;
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
/* Build grammar table */
|
||||
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
|
||||
@@ -1710,7 +1657,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_SUB:
|
||||
case RULE_TIL:
|
||||
case RULE_SPLIT:
|
||||
/* [rule, rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -1060,11 +1060,19 @@ void janet_buffer_format(
|
||||
break;
|
||||
}
|
||||
case 's': {
|
||||
const char *s = janet_getcbytes(argv, arg);
|
||||
JanetByteView bytes = janet_getbytes(argv, arg);
|
||||
const uint8_t *s = bytes.bytes;
|
||||
int32_t l = bytes.len;
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_cstring(b, s);
|
||||
janet_buffer_push_bytes(b, s, l);
|
||||
else {
|
||||
nb = snprintf(item, MAX_ITEM, form, s);
|
||||
if (l != (int32_t) strlen((const char *) s))
|
||||
janet_panic("string contains zeros");
|
||||
if (!strchr(form, '.') && l >= 100) {
|
||||
janet_panic("no precision and string is too long to be formatted");
|
||||
} else {
|
||||
nb = snprintf(item, MAX_ITEM, form, s);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -26,10 +26,9 @@
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Run a string of code. The return value is a set of error flags, JANET_DO_ERROR_RUNTIME, JANET_DO_ERROR_COMPILE, and JANET_DOR_ERROR_PARSE if
|
||||
* any errors were encountered in those phases. More information is printed to stderr. */
|
||||
/* Run a string */
|
||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||
JanetParser *parser;
|
||||
JanetParser parser;
|
||||
int errflags = 0, done = 0;
|
||||
int32_t index = 0;
|
||||
Janet ret = janet_wrap_nil();
|
||||
@@ -38,16 +37,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
|
||||
if (where) janet_gcroot(janet_wrap_string(where));
|
||||
if (NULL == sourcePath) sourcePath = "<unknown>";
|
||||
parser = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_init(parser);
|
||||
janet_gcroot(janet_wrap_abstract(parser));
|
||||
janet_parser_init(&parser);
|
||||
|
||||
/* While we haven't seen an error */
|
||||
while (!done) {
|
||||
|
||||
/* Evaluate parsed values */
|
||||
while (janet_parser_has_more(parser)) {
|
||||
Janet form = janet_parser_produce(parser);
|
||||
while (janet_parser_has_more(&parser)) {
|
||||
Janet form = janet_parser_produce(&parser);
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
@@ -56,13 +53,13 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace_ext(fiber, ret, "");
|
||||
errflags |= JANET_DO_ERROR_RUNTIME;
|
||||
errflags |= 0x01;
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
ret = janet_wrap_string(cres.error);
|
||||
int32_t line = (int32_t) parser->line;
|
||||
int32_t col = (int32_t) parser->column;
|
||||
int32_t line = (int32_t) parser.line;
|
||||
int32_t col = (int32_t) parser.column;
|
||||
if ((cres.error_mapping.line > 0) &&
|
||||
(cres.error_mapping.column > 0)) {
|
||||
line = cres.error_mapping.line;
|
||||
@@ -76,7 +73,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
|
||||
line, col, (const char *)cres.error);
|
||||
}
|
||||
errflags |= JANET_DO_ERROR_COMPILE;
|
||||
errflags |= 0x02;
|
||||
done = 1;
|
||||
}
|
||||
}
|
||||
@@ -84,16 +81,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
if (done) break;
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(parser)) {
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_ERROR: {
|
||||
const char *e = janet_parser_error(parser);
|
||||
errflags |= JANET_DO_ERROR_PARSE;
|
||||
const char *e = janet_parser_error(&parser);
|
||||
errflags |= 0x04;
|
||||
ret = janet_cstringv(e);
|
||||
int32_t line = (int32_t) parser->line;
|
||||
int32_t col = (int32_t) parser->column;
|
||||
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;
|
||||
@@ -101,9 +98,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index >= len) {
|
||||
janet_parser_eof(parser);
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(parser, bytes[index++]);
|
||||
janet_parser_consume(&parser, bytes[index++]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -111,7 +108,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
|
||||
/* Clean up and return errors */
|
||||
janet_gcunroot(janet_wrap_abstract(parser));
|
||||
janet_parser_deinit(&parser);
|
||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||
#ifdef JANET_EV
|
||||
/* Enter the event loop if we are not already in it */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,16 +23,11 @@
|
||||
#ifndef JANET_STATE_H_defined
|
||||
#define JANET_STATE_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include <stdint.h>
|
||||
#endif
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
@@ -58,22 +53,13 @@ typedef struct {
|
||||
void *data;
|
||||
} JanetQueue;
|
||||
|
||||
#ifdef JANET_EV
|
||||
typedef struct {
|
||||
JanetTimestamp when;
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *curr_fiber;
|
||||
uint32_t sched_id;
|
||||
int is_error;
|
||||
int has_worker;
|
||||
#ifdef JANET_WINDOWS
|
||||
HANDLE worker;
|
||||
HANDLE worker_event;
|
||||
#else
|
||||
pthread_t worker;
|
||||
#endif
|
||||
} JanetTimeout;
|
||||
#endif
|
||||
|
||||
/* Registry table for C functions - contains metadata that can
|
||||
* be looked up by cfunction pointer. All strings here are pointing to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -301,7 +301,6 @@ int janet_scan_number_base(
|
||||
if (base == 0) {
|
||||
base = 10;
|
||||
}
|
||||
int exp_base = base;
|
||||
|
||||
/* Skip leading zeros */
|
||||
while (str < end && (*str == '0' || *str == '.')) {
|
||||
@@ -323,12 +322,6 @@ int janet_scan_number_base(
|
||||
} else if (*str == '&') {
|
||||
foundexp = 1;
|
||||
break;
|
||||
} else if (base == 16 && (*str == 'P' || *str == 'p')) { /* IEEE hex float */
|
||||
foundexp = 1;
|
||||
exp_base = 10;
|
||||
base = 2;
|
||||
ex *= 4; /* We need to correct the current exponent after we change the base */
|
||||
break;
|
||||
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
|
||||
foundexp = 1;
|
||||
break;
|
||||
@@ -367,9 +360,9 @@ int janet_scan_number_base(
|
||||
}
|
||||
while (str < end) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= exp_base) goto error;
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
if (ee < (INT32_MAX / 40)) {
|
||||
ee = exp_base * ee + digit;
|
||||
ee = base * ee + digit;
|
||||
}
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
|
||||
1915
src/core/sysir.c
1915
src/core/sysir.c
File diff suppressed because it is too large
Load Diff
337
src/core/sysir.h
337
src/core/sysir.h
@@ -1,337 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2024 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/****
|
||||
* The System Dialect Intermediate Representation (sysir) is a compiler intermediate representation
|
||||
* that for "System Janet" a dialect for "System Programming". Sysir can then be retargeted to C or direct to machine
|
||||
* code for JIT or AOT compilation.
|
||||
*/
|
||||
|
||||
/* TODO
|
||||
* [x] encode constants directly in 3 address codes - makes codegen easier
|
||||
* [x] typed constants
|
||||
* [x] named registers and types
|
||||
* [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
|
||||
* [-] x86/x64 machine code target - in progress
|
||||
* [ ] handle floating point types
|
||||
* [ ] handle array types
|
||||
* [ ] emit machine code directly
|
||||
* [ ] target specific extensions - custom instructions and custom primitives
|
||||
* [ ] better casting semantics
|
||||
* [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)?
|
||||
* [x] fixed-size array types
|
||||
* [x] recursive pointer types
|
||||
* [ ] global and thread local state
|
||||
* [x] union types?
|
||||
* [x] incremental compilation - save type definitions for later
|
||||
* [ ] Extension to C target for interfacing with Janet
|
||||
* [x] pointer math, pointer types
|
||||
* [x] composite types - support for load, store, move, and function args.
|
||||
* [x] Have some mechanism for field access (dest = src.offset)
|
||||
* [x] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this.
|
||||
* [x] support for stack allocation of arrays
|
||||
* [ ] more math intrinsics
|
||||
* [x] source mapping (using built in Janet source mapping metadata on tuples)
|
||||
* [x] unit type or void type
|
||||
* [ ] (typed) function pointer types and remove calling untyped pointers
|
||||
* [x] APL array semantics for binary operands (maybe?)
|
||||
* [ ] a few built-in array combinators (maybe?)
|
||||
* [ ] multiple error messages in one pass
|
||||
* [ ] better verification of constants
|
||||
* [x] don't allow redefining types
|
||||
* [ ] generate elf/mach-o/pe directly
|
||||
* [ ] elf
|
||||
* [ ] mach-o
|
||||
* [ ] pe
|
||||
* [ ] generate dwarf info
|
||||
*/
|
||||
|
||||
#ifndef JANET_SYSIR_H
|
||||
#define JANET_SYSIR_H
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
typedef enum {
|
||||
JANET_PRIM_U8,
|
||||
JANET_PRIM_S8,
|
||||
JANET_PRIM_U16,
|
||||
JANET_PRIM_S16,
|
||||
JANET_PRIM_U32,
|
||||
JANET_PRIM_S32,
|
||||
JANET_PRIM_U64,
|
||||
JANET_PRIM_S64,
|
||||
JANET_PRIM_F32,
|
||||
JANET_PRIM_F64,
|
||||
JANET_PRIM_POINTER,
|
||||
JANET_PRIM_BOOLEAN,
|
||||
JANET_PRIM_STRUCT,
|
||||
JANET_PRIM_UNION,
|
||||
JANET_PRIM_ARRAY,
|
||||
JANET_PRIM_VOID,
|
||||
JANET_PRIM_UNKNOWN
|
||||
} JanetPrim;
|
||||
|
||||
typedef struct {
|
||||
const char *name;
|
||||
JanetPrim prim;
|
||||
} JanetPrimName;
|
||||
|
||||
typedef enum {
|
||||
JANET_SYSOP_LINK_NAME,
|
||||
JANET_SYSOP_PARAMETER_COUNT,
|
||||
JANET_SYSOP_CALLING_CONVENTION,
|
||||
JANET_SYSOP_MOVE,
|
||||
JANET_SYSOP_CAST,
|
||||
JANET_SYSOP_ADD,
|
||||
JANET_SYSOP_SUBTRACT,
|
||||
JANET_SYSOP_MULTIPLY,
|
||||
JANET_SYSOP_DIVIDE,
|
||||
JANET_SYSOP_BAND,
|
||||
JANET_SYSOP_BOR,
|
||||
JANET_SYSOP_BXOR,
|
||||
JANET_SYSOP_BNOT,
|
||||
JANET_SYSOP_SHL,
|
||||
JANET_SYSOP_SHR,
|
||||
JANET_SYSOP_LOAD,
|
||||
JANET_SYSOP_STORE,
|
||||
JANET_SYSOP_GT,
|
||||
JANET_SYSOP_LT,
|
||||
JANET_SYSOP_EQ,
|
||||
JANET_SYSOP_NEQ,
|
||||
JANET_SYSOP_GTE,
|
||||
JANET_SYSOP_LTE,
|
||||
JANET_SYSOP_CALL,
|
||||
JANET_SYSOP_SYSCALL,
|
||||
JANET_SYSOP_RETURN,
|
||||
JANET_SYSOP_JUMP,
|
||||
JANET_SYSOP_BRANCH,
|
||||
JANET_SYSOP_BRANCH_NOT,
|
||||
JANET_SYSOP_ADDRESS,
|
||||
JANET_SYSOP_TYPE_PRIMITIVE,
|
||||
JANET_SYSOP_TYPE_STRUCT,
|
||||
JANET_SYSOP_TYPE_BIND,
|
||||
JANET_SYSOP_ARG,
|
||||
JANET_SYSOP_FIELD_GETP,
|
||||
JANET_SYSOP_ARRAY_GETP,
|
||||
JANET_SYSOP_ARRAY_PGETP,
|
||||
JANET_SYSOP_TYPE_POINTER,
|
||||
JANET_SYSOP_TYPE_ARRAY,
|
||||
JANET_SYSOP_TYPE_UNION,
|
||||
JANET_SYSOP_POINTER_ADD,
|
||||
JANET_SYSOP_POINTER_SUBTRACT,
|
||||
JANET_SYSOP_LABEL
|
||||
} JanetSysOp;
|
||||
|
||||
typedef struct {
|
||||
JanetPrim prim;
|
||||
union {
|
||||
struct {
|
||||
uint32_t field_count;
|
||||
uint32_t field_start;
|
||||
} st;
|
||||
struct {
|
||||
uint32_t type;
|
||||
} pointer;
|
||||
struct {
|
||||
uint32_t type;
|
||||
uint64_t fixed_count;
|
||||
} array;
|
||||
};
|
||||
} JanetSysTypeInfo;
|
||||
|
||||
typedef struct {
|
||||
uint32_t type;
|
||||
} JanetSysTypeField;
|
||||
|
||||
#define JANET_SYS_CALLFLAG_HAS_DEST 1
|
||||
#define JANET_SYS_CALLFLAG_VARARGS 2
|
||||
|
||||
/* Allow read arguments to be constants to allow
|
||||
* encoding immediates. This makes codegen easier. */
|
||||
#define JANET_SYS_MAX_OPERAND 0x7FFFFFFFU
|
||||
#define JANET_SYS_CONSTANT_PREFIX 0x80000000U
|
||||
|
||||
typedef enum {
|
||||
JANET_SYS_CC_DEFAULT, /* Reasonable default - maps to a specific cc based on target */
|
||||
JANET_SYS_CC_SYSCALL, /* Reasonable default for platform syscalls - maps to a specific cc based on target */
|
||||
JANET_SYS_CC_X86_CDECL,
|
||||
JANET_SYS_CC_X86_STDCALL,
|
||||
JANET_SYS_CC_X86_FASTCALL,
|
||||
JANET_SYS_CC_X64_SYSV,
|
||||
JANET_SYS_CC_X64_SYSV_SYSCALL,
|
||||
JANET_SYS_CC_X64_WINDOWS,
|
||||
} JanetSysCallingConvention;
|
||||
|
||||
typedef enum {
|
||||
JANET_SYS_TARGET_X64_WINDOWS, /* 64 bit, modern windows */
|
||||
JANET_SYS_TARGET_X64_LINUX, /* x64 linux with recent kernel */
|
||||
} JanetSysTarget;
|
||||
|
||||
typedef struct {
|
||||
JanetSysOp opcode;
|
||||
union {
|
||||
struct {
|
||||
uint32_t dest;
|
||||
uint32_t lhs;
|
||||
uint32_t rhs;
|
||||
} three;
|
||||
struct {
|
||||
uint32_t dest;
|
||||
uint32_t callee;
|
||||
uint32_t arg_count;
|
||||
uint8_t flags;
|
||||
JanetSysCallingConvention calling_convention;
|
||||
} call;
|
||||
struct {
|
||||
uint32_t dest;
|
||||
uint32_t src;
|
||||
} two;
|
||||
struct {
|
||||
uint32_t src;
|
||||
} one;
|
||||
struct {
|
||||
uint32_t to;
|
||||
} jump;
|
||||
struct {
|
||||
uint32_t cond;
|
||||
uint32_t to;
|
||||
} branch;
|
||||
struct {
|
||||
uint32_t dest_type;
|
||||
uint32_t prim;
|
||||
} type_prim;
|
||||
struct {
|
||||
uint32_t dest_type;
|
||||
uint32_t arg_count;
|
||||
} type_types;
|
||||
struct {
|
||||
uint32_t dest;
|
||||
uint32_t type;
|
||||
} type_bind;
|
||||
struct {
|
||||
uint32_t args[3];
|
||||
} arg;
|
||||
struct {
|
||||
uint32_t r;
|
||||
uint32_t st;
|
||||
uint32_t field;
|
||||
} field;
|
||||
struct {
|
||||
uint32_t dest_type;
|
||||
uint32_t type;
|
||||
// Include address space?
|
||||
} pointer;
|
||||
struct {
|
||||
uint32_t dest_type;
|
||||
uint32_t type;
|
||||
uint64_t fixed_count;
|
||||
} array;
|
||||
struct {
|
||||
uint32_t id;
|
||||
} label;
|
||||
struct {
|
||||
uint32_t value;
|
||||
uint32_t has_value;
|
||||
} ret;
|
||||
};
|
||||
int32_t line;
|
||||
int32_t column;
|
||||
} JanetSysInstruction;
|
||||
|
||||
/* Shared data between multiple
|
||||
* IR Function bodies. Used to link
|
||||
* multiple functions together in a
|
||||
* single executable or shared object with
|
||||
* multiple entry points. Contains shared
|
||||
* type declarations, as well as a table of linked
|
||||
* functions. */
|
||||
typedef struct {
|
||||
uint32_t old_type_def_count;
|
||||
uint32_t type_def_count;
|
||||
uint32_t field_def_count;
|
||||
JanetSysTypeInfo *type_defs;
|
||||
JanetString *type_names;
|
||||
JanetSysTypeField *field_defs;
|
||||
JanetTable *irs;
|
||||
JanetArray *ir_ordered;
|
||||
JanetTable *type_name_lookup;
|
||||
} JanetSysIRLinkage;
|
||||
|
||||
/* Keep source code information as well as
|
||||
* typing information along with constants */
|
||||
typedef struct {
|
||||
uint32_t type;
|
||||
Janet value;
|
||||
// TODO - source and line
|
||||
} JanetSysConstant;
|
||||
|
||||
/* IR representation for a single function.
|
||||
* Allow for incremental compilation and linking. */
|
||||
typedef struct {
|
||||
JanetSysIRLinkage *linkage;
|
||||
JanetString link_name;
|
||||
uint32_t instruction_count;
|
||||
uint32_t register_count;
|
||||
uint32_t constant_count;
|
||||
uint32_t return_type;
|
||||
uint32_t has_return_type;
|
||||
uint32_t parameter_count;
|
||||
uint32_t label_count;
|
||||
uint32_t *types;
|
||||
JanetSysInstruction *instructions;
|
||||
JanetString *register_names;
|
||||
JanetSysConstant *constants;
|
||||
JanetTable *register_name_lookup;
|
||||
JanetTable *labels;
|
||||
JanetSysCallingConvention calling_convention;
|
||||
Janet error_ctx; /* Temporary for holding error messages */
|
||||
} JanetSysIR;
|
||||
|
||||
/* Delay alignment info for the most part to the lowering phase */
|
||||
typedef struct {
|
||||
uint32_t size;
|
||||
uint32_t alignment;
|
||||
} JanetSysTypeLayout;
|
||||
|
||||
/* Keep track of names for each instruction */
|
||||
extern const char *janet_sysop_names[];
|
||||
extern const char *prim_to_prim_name[];
|
||||
|
||||
/* Utilities */
|
||||
|
||||
uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op);
|
||||
|
||||
/* Get list of uint32_t instruction arguments from a call or other variable length instruction.
|
||||
Needs to be free with janet_sfree (or you can leak it and the garbage collector will eventually clean
|
||||
* it up). */
|
||||
uint32_t *janet_sys_callargs(JanetSysInstruction *instr, uint32_t *count);
|
||||
|
||||
/* Lowering */
|
||||
void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into);
|
||||
void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer);
|
||||
void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetSysTarget target, JanetBuffer *buffer);
|
||||
|
||||
#endif
|
||||
@@ -1,376 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2024 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "sysir.h"
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Lowering to C */
|
||||
|
||||
static const char *c_prim_names[] = {
|
||||
"uint8_t",
|
||||
"int8_t",
|
||||
"uint16_t",
|
||||
"int16_t",
|
||||
"uint32_t",
|
||||
"int32_t",
|
||||
"uint64_t",
|
||||
"int64_t",
|
||||
"float",
|
||||
"double",
|
||||
"void *",
|
||||
"bool",
|
||||
"!!!struct",
|
||||
"!!!union",
|
||||
"!!!array",
|
||||
"void",
|
||||
"!!!unknown"
|
||||
};
|
||||
|
||||
/* Print a C constant */
|
||||
static void print_const_c(JanetSysIR *ir, JanetBuffer *buf, Janet c, uint32_t tid) {
|
||||
/* JanetSysTypeInfo *tinfo = &ir->linkage->type_defs[tid]; */
|
||||
if (janet_checktype(c, JANET_TUPLE)) {
|
||||
const Janet *elements = janet_unwrap_tuple(c);
|
||||
janet_formatb(buf, "((_t%d){", tid);
|
||||
for (int32_t i = 0; i < janet_tuple_length(elements); i++) {
|
||||
if (i > 0) janet_formatb(buf, ", ");
|
||||
/* TODO - limit recursion? */
|
||||
uint32_t sub_type = ir->linkage->type_defs[tid].array.type;
|
||||
print_const_c(ir, buf, elements[i], sub_type);
|
||||
}
|
||||
janet_formatb(buf, "})");
|
||||
} else if (janet_checktype(c, JANET_ABSTRACT)) {
|
||||
/* Allow printing int types */
|
||||
janet_formatb(buf, "%V", c);
|
||||
} else {
|
||||
janet_formatb(buf, "%v", c);
|
||||
}
|
||||
}
|
||||
|
||||
static void c_op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) {
|
||||
if (reg < JANET_SYS_MAX_OPERAND) {
|
||||
janet_formatb(buf, "_r%u", reg);
|
||||
} else {
|
||||
uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX;
|
||||
uint32_t tid = ir->constants[constant_id].type;
|
||||
Janet c = ir->constants[constant_id].value;
|
||||
print_const_c(ir, buf, c, tid);
|
||||
}
|
||||
}
|
||||
|
||||
static void c_emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf, JanetSysInstruction instruction, const char *op, int pointer_sugar) {
|
||||
uint32_t operand_type = ir->types[instruction.three.dest];
|
||||
tempbuf->count = 0;
|
||||
uint32_t index_index = 0;
|
||||
int is_pointer = 0;
|
||||
JanetSysIRLinkage *linkage = ir->linkage;
|
||||
|
||||
/* Top-level pointer semantics */
|
||||
if (pointer_sugar && janet_sys_optype(ir, instruction.three.dest) == JANET_PRIM_POINTER) {
|
||||
operand_type = linkage->type_defs[operand_type].pointer.type;
|
||||
is_pointer = 1;
|
||||
}
|
||||
|
||||
/* Add nested for loops for any dimensionality of array */
|
||||
while (linkage->type_defs[operand_type].prim == JANET_PRIM_ARRAY) {
|
||||
janet_formatb(buffer, " for (size_t _j%u = 0; _j%u < %u; _j%u++) ",
|
||||
index_index, index_index,
|
||||
linkage->type_defs[operand_type].array.fixed_count,
|
||||
index_index);
|
||||
if (is_pointer) {
|
||||
janet_formatb(tempbuf, "->els[_j%u]", index_index);
|
||||
is_pointer = 0;
|
||||
} else {
|
||||
janet_formatb(tempbuf, ".els[_j%u]", index_index);
|
||||
}
|
||||
operand_type = linkage->type_defs[operand_type].array.type;
|
||||
index_index++;
|
||||
}
|
||||
|
||||
if (is_pointer) {
|
||||
janet_formatb(buffer, " *_r%u = *_r%u %s *_r%u;\n",
|
||||
instruction.three.dest,
|
||||
instruction.three.lhs,
|
||||
op,
|
||||
instruction.three.rhs);
|
||||
janet_formatb(buffer, " *_r%u = *", instruction.three.dest);
|
||||
c_op_or_const(ir, buffer, instruction.three.lhs);
|
||||
janet_formatb(buffer, " %s ", op);
|
||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
||||
janet_formatb(buffer, ";\n");
|
||||
} else {
|
||||
Janet index_part = janet_wrap_buffer(tempbuf);
|
||||
janet_formatb(buffer, " _r%u%V = ", instruction.three.dest, index_part);
|
||||
c_op_or_const(ir, buffer, instruction.three.lhs);
|
||||
janet_formatb(buffer, "%V %s ", index_part, op);
|
||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
||||
janet_formatb(buffer, "%V;\n", index_part);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
|
||||
|
||||
JanetBuffer *tempbuf = janet_buffer(0);
|
||||
|
||||
#define EMITBINOP(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 1)
|
||||
#define EMITBINOP_NOSUGAR(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 0)
|
||||
|
||||
/* Prelude */
|
||||
janet_formatb(buffer, "#include <stddef.h>\n#include <unistd.h>\n#include <stdlib.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stdio.h>\n#include <sys/syscall.h>\n#define _t0 void\n\n");
|
||||
|
||||
/* Emit type defs */
|
||||
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
|
||||
JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
|
||||
for (uint32_t i = 0; i < ir->instruction_count; i++) {
|
||||
JanetSysInstruction instruction = ir->instructions[i];
|
||||
switch (instruction.opcode) {
|
||||
default:
|
||||
continue;
|
||||
case JANET_SYSOP_TYPE_PRIMITIVE:
|
||||
case JANET_SYSOP_TYPE_STRUCT:
|
||||
case JANET_SYSOP_TYPE_UNION:
|
||||
case JANET_SYSOP_TYPE_POINTER:
|
||||
case JANET_SYSOP_TYPE_ARRAY:
|
||||
break;
|
||||
}
|
||||
if (instruction.line > 0) {
|
||||
janet_formatb(buffer, "#line %d\n", instruction.line);
|
||||
}
|
||||
switch (instruction.opcode) {
|
||||
default:
|
||||
break;
|
||||
case JANET_SYSOP_TYPE_PRIMITIVE:
|
||||
janet_formatb(buffer, "typedef %s _t%u;\n", c_prim_names[instruction.type_prim.prim], instruction.type_prim.dest_type);
|
||||
break;
|
||||
case JANET_SYSOP_TYPE_STRUCT:
|
||||
case JANET_SYSOP_TYPE_UNION:
|
||||
janet_formatb(buffer, (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) ? "typedef struct {\n" : "typedef union {\n");
|
||||
for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) {
|
||||
uint32_t offset = j / 3 + 1;
|
||||
uint32_t index = j % 3;
|
||||
JanetSysInstruction arg_instruction = ir->instructions[i + offset];
|
||||
janet_formatb(buffer, " _t%u _f%u;\n", arg_instruction.arg.args[index], j);
|
||||
}
|
||||
janet_formatb(buffer, "} _t%u;\n", instruction.type_types.dest_type);
|
||||
break;
|
||||
case JANET_SYSOP_TYPE_POINTER:
|
||||
janet_formatb(buffer, "typedef _t%u *_t%u;\n", instruction.pointer.type, instruction.pointer.dest_type);
|
||||
break;
|
||||
case JANET_SYSOP_TYPE_ARRAY:
|
||||
janet_formatb(buffer, "typedef struct { _t%u els[%u]; } _t%u;\n", instruction.array.type, instruction.array.fixed_count, instruction.array.dest_type);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Emit function header */
|
||||
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
|
||||
JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
|
||||
if (ir->link_name == NULL) {
|
||||
continue;
|
||||
}
|
||||
janet_formatb(buffer, "\n\n_t%u %s(", ir->return_type, (ir->link_name != NULL) ? ir->link_name : janet_cstring("_thunk"));
|
||||
for (uint32_t i = 0; i < ir->parameter_count; i++) {
|
||||
if (i) janet_buffer_push_cstring(buffer, ", ");
|
||||
janet_formatb(buffer, "_t%u _r%u", ir->types[i], i);
|
||||
}
|
||||
janet_buffer_push_cstring(buffer, ")\n{\n");
|
||||
for (uint32_t i = ir->parameter_count; i < ir->register_count; i++) {
|
||||
janet_formatb(buffer, " _t%u _r%u;\n", ir->types[i], i);
|
||||
}
|
||||
janet_buffer_push_cstring(buffer, "\n");
|
||||
|
||||
/* Emit body */
|
||||
for (uint32_t i = 0; i < ir->instruction_count; i++) {
|
||||
JanetSysInstruction instruction = ir->instructions[i];
|
||||
if (instruction.line > 0) {
|
||||
janet_formatb(buffer, "#line %d\n", instruction.line);
|
||||
}
|
||||
switch (instruction.opcode) {
|
||||
case JANET_SYSOP_TYPE_PRIMITIVE:
|
||||
case JANET_SYSOP_TYPE_BIND:
|
||||
case JANET_SYSOP_TYPE_STRUCT:
|
||||
case JANET_SYSOP_TYPE_UNION:
|
||||
case JANET_SYSOP_TYPE_POINTER:
|
||||
case JANET_SYSOP_TYPE_ARRAY:
|
||||
case JANET_SYSOP_ARG:
|
||||
case JANET_SYSOP_LINK_NAME:
|
||||
case JANET_SYSOP_PARAMETER_COUNT:
|
||||
case JANET_SYSOP_CALLING_CONVENTION:
|
||||
break;
|
||||
case JANET_SYSOP_LABEL: {
|
||||
janet_formatb(buffer, "\n_label_%u:\n", instruction.label.id);
|
||||
break;
|
||||
}
|
||||
case JANET_SYSOP_ADDRESS:
|
||||
janet_formatb(buffer, " _r%u = (void *) &", instruction.two.dest);
|
||||
c_op_or_const(ir, buffer, instruction.two.src);
|
||||
janet_formatb(buffer, ";\n");
|
||||
break;
|
||||
case JANET_SYSOP_JUMP:
|
||||
janet_formatb(buffer, " goto _label_%u;\n", instruction.jump.to);
|
||||
break;
|
||||
case JANET_SYSOP_BRANCH:
|
||||
case JANET_SYSOP_BRANCH_NOT:
|
||||
janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? " if (" : " if (!");
|
||||
c_op_or_const(ir, buffer, instruction.branch.cond);
|
||||
janet_formatb(buffer, ") goto _label_%u;\n", instruction.branch.to);
|
||||
break;
|
||||
case JANET_SYSOP_RETURN:
|
||||
if (instruction.ret.has_value) {
|
||||
janet_buffer_push_cstring(buffer, " return ");
|
||||
c_op_or_const(ir, buffer, instruction.ret.value);
|
||||
janet_buffer_push_cstring(buffer, ";\n");
|
||||
} else {
|
||||
janet_buffer_push_cstring(buffer, " return;\n");
|
||||
}
|
||||
break;
|
||||
case JANET_SYSOP_ADD:
|
||||
EMITBINOP("+");
|
||||
break;
|
||||
case JANET_SYSOP_POINTER_ADD:
|
||||
EMITBINOP_NOSUGAR("+");
|
||||
break;
|
||||
case JANET_SYSOP_SUBTRACT:
|
||||
EMITBINOP("-");
|
||||
break;
|
||||
case JANET_SYSOP_POINTER_SUBTRACT:
|
||||
EMITBINOP_NOSUGAR("-");
|
||||
break;
|
||||
case JANET_SYSOP_MULTIPLY:
|
||||
EMITBINOP("*");
|
||||
break;
|
||||
case JANET_SYSOP_DIVIDE:
|
||||
EMITBINOP("/");
|
||||
break;
|
||||
case JANET_SYSOP_GT:
|
||||
EMITBINOP(">");
|
||||
break;
|
||||
case JANET_SYSOP_GTE:
|
||||
EMITBINOP(">");
|
||||
break;
|
||||
case JANET_SYSOP_LT:
|
||||
EMITBINOP("<");
|
||||
break;
|
||||
case JANET_SYSOP_LTE:
|
||||
EMITBINOP("<=");
|
||||
break;
|
||||
case JANET_SYSOP_EQ:
|
||||
EMITBINOP("==");
|
||||
break;
|
||||
case JANET_SYSOP_NEQ:
|
||||
EMITBINOP("!=");
|
||||
break;
|
||||
case JANET_SYSOP_BAND:
|
||||
EMITBINOP("&");
|
||||
break;
|
||||
case JANET_SYSOP_BOR:
|
||||
EMITBINOP("|");
|
||||
break;
|
||||
case JANET_SYSOP_BXOR:
|
||||
EMITBINOP("^");
|
||||
break;
|
||||
case JANET_SYSOP_SHL:
|
||||
EMITBINOP("<<");
|
||||
break;
|
||||
case JANET_SYSOP_SHR:
|
||||
EMITBINOP(">>");
|
||||
break;
|
||||
case JANET_SYSOP_SYSCALL:
|
||||
case JANET_SYSOP_CALL: {
|
||||
if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) {
|
||||
janet_formatb(buffer, " _r%u = ", instruction.call.dest);
|
||||
} else {
|
||||
janet_formatb(buffer, " ");
|
||||
}
|
||||
if (instruction.opcode == JANET_SYSOP_SYSCALL) {
|
||||
janet_formatb(buffer, "syscall(");
|
||||
c_op_or_const(ir, buffer, instruction.call.callee);
|
||||
} else {
|
||||
c_op_or_const(ir, buffer, instruction.call.callee);
|
||||
janet_formatb(buffer, "(");
|
||||
}
|
||||
uint32_t count;
|
||||
uint32_t *args = janet_sys_callargs(ir->instructions + i, &count);
|
||||
for (uint32_t j = 0; j < count; j++) {
|
||||
if (j || instruction.opcode == JANET_SYSOP_SYSCALL) janet_formatb(buffer, ", ");
|
||||
c_op_or_const(ir, buffer, args[j]);
|
||||
}
|
||||
janet_formatb(buffer, ");\n");
|
||||
break;
|
||||
}
|
||||
case JANET_SYSOP_CAST: {
|
||||
uint32_t to = ir->types[instruction.two.dest];
|
||||
janet_formatb(buffer, " _r%u = (_t%u) ", instruction.two.dest, to);
|
||||
c_op_or_const(ir, buffer, instruction.two.src);
|
||||
janet_formatb(buffer, ";\n");
|
||||
break;
|
||||
}
|
||||
case JANET_SYSOP_MOVE:
|
||||
janet_formatb(buffer, " _r%u = ", instruction.two.dest);
|
||||
c_op_or_const(ir, buffer, instruction.two.src);
|
||||
janet_formatb(buffer, ";\n");
|
||||
break;
|
||||
case JANET_SYSOP_BNOT:
|
||||
janet_formatb(buffer, " _r%u = ~", instruction.two.dest);
|
||||
c_op_or_const(ir, buffer, instruction.two.src);
|
||||
janet_formatb(buffer, ";\n");
|
||||
break;
|
||||
case JANET_SYSOP_LOAD:
|
||||
janet_formatb(buffer, " _r%u = *(", instruction.two.dest);
|
||||
c_op_or_const(ir, buffer, instruction.two.src);
|
||||
janet_formatb(buffer, ");\n");
|
||||
break;
|
||||
case JANET_SYSOP_STORE:
|
||||
janet_formatb(buffer, " *(_r%u) = ", instruction.two.dest);
|
||||
c_op_or_const(ir, buffer, instruction.two.src);
|
||||
janet_formatb(buffer, ";\n");
|
||||
break;
|
||||
case JANET_SYSOP_FIELD_GETP:
|
||||
janet_formatb(buffer, " _r%u = &(_r%u._f%u);\n", instruction.field.r, instruction.field.st, instruction.field.field);
|
||||
janet_formatb(buffer, " _r%u = &(", instruction.field.r);
|
||||
janet_formatb(buffer, "._f%u);\n", instruction.field.field);
|
||||
break;
|
||||
case JANET_SYSOP_ARRAY_GETP:
|
||||
janet_formatb(buffer, " _r%u = &(_r%u.els[", instruction.three.dest, instruction.three.lhs);
|
||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
||||
janet_buffer_push_cstring(buffer, "]);\n");
|
||||
break;
|
||||
case JANET_SYSOP_ARRAY_PGETP:
|
||||
janet_formatb(buffer, " _r%u = &(_r%u->els[", instruction.three.dest, instruction.three.lhs);
|
||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
||||
janet_buffer_push_cstring(buffer, "]);\n");
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
janet_buffer_push_cstring(buffer, "}\n");
|
||||
#undef EMITBINOP
|
||||
#undef EMITBINOP_NOSUGAR
|
||||
}
|
||||
|
||||
}
|
||||
1104
src/core/sysir_x86.c
1104
src/core/sysir_x86.c
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -372,14 +372,12 @@ JANET_CORE_FN(cfun_table_setproto,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_tostruct,
|
||||
"(table/to-struct tab &opt proto)",
|
||||
"Convert a table to a struct. Returns a new struct.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
"(table/to-struct tab)",
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
JanetStruct proto = janet_optstruct(argv, argc, 1, NULL);
|
||||
JanetStruct st = janet_table_to_struct(t);
|
||||
janet_struct_proto(st) = proto;
|
||||
return janet_wrap_struct(st);
|
||||
return janet_wrap_struct(janet_table_to_struct(t));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_rawget,
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -931,24 +931,27 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
||||
#include <mach/clock.h>
|
||||
#include <mach/mach.h>
|
||||
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
||||
if (source == JANET_TIME_CPUTIME) {
|
||||
clock_t tmp = clock();
|
||||
spec->tv_sec = tmp / CLOCKS_PER_SEC;
|
||||
spec->tv_nsec = ((tmp - (spec->tv_sec * CLOCKS_PER_SEC)) * 1000000000) / CLOCKS_PER_SEC;
|
||||
} else {
|
||||
if (source == JANET_TIME_REALTIME) {
|
||||
clock_serv_t cclock;
|
||||
mach_timespec_t mts;
|
||||
clock_id_t cid = CALENDAR_CLOCK;
|
||||
if (source == JANET_TIME_REALTIME) {
|
||||
cid = CALENDAR_CLOCK;
|
||||
} else if (source == JANET_TIME_MONOTONIC) {
|
||||
cid = SYSTEM_CLOCK;
|
||||
}
|
||||
host_get_clock_service(mach_host_self(), cid, &cclock);
|
||||
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
||||
clock_get_time(cclock, &mts);
|
||||
mach_port_deallocate(mach_task_self(), cclock);
|
||||
spec->tv_sec = mts.tv_sec;
|
||||
spec->tv_nsec = mts.tv_nsec;
|
||||
} else if (source == JANET_TIME_MONOTONIC) {
|
||||
clock_serv_t cclock;
|
||||
int nsecs;
|
||||
mach_msg_type_number_t count;
|
||||
host_get_clock_service(mach_host_self(), clock, &cclock);
|
||||
clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);
|
||||
mach_port_deallocate(mach_task_self(), cclock);
|
||||
clock_getres(CLOCK_MONOTONIC, spec);
|
||||
}
|
||||
if (source == JANET_TIME_CPUTIME) {
|
||||
clock_t tmp = clock();
|
||||
spec->tv_sec = tmp;
|
||||
spec->tv_nsec = (tmp - spec->tv_sec) * 1.0e9;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -205,9 +205,9 @@ int janet_make_pipe(JanetHandle handles[2], int mode);
|
||||
#ifdef JANET_FILEWATCH
|
||||
void janet_lib_filewatch(JanetTable *env);
|
||||
#endif
|
||||
#endif
|
||||
#ifdef JANET_FFI
|
||||
void janet_lib_ffi(JanetTable *env);
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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
|
||||
@@ -115,7 +115,7 @@
|
||||
#define vm_maybe_auto_suspend(COND)
|
||||
#else
|
||||
#define vm_maybe_auto_suspend(COND) do { \
|
||||
if ((COND) && janet_atomic_load_relaxed(&janet_vm.auto_suspend)) { \
|
||||
if ((COND) && janet_vm.auto_suspend) { \
|
||||
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
|
||||
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
|
||||
} \
|
||||
@@ -798,14 +798,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_JUMP)
|
||||
vm_maybe_auto_suspend(DS <= 0);
|
||||
pc += DS;
|
||||
vm_maybe_auto_suspend(DS <= 0);
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF)
|
||||
if (janet_truthy(stack[A])) {
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@@ -815,15 +815,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_truthy(stack[A])) {
|
||||
pc++;
|
||||
} else {
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@@ -833,8 +833,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc++;
|
||||
} else {
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
@@ -1388,11 +1388,6 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
/* Should match logic in janet_signalv */
|
||||
#ifdef JANET_EV
|
||||
if (janet_vm.root_fiber != NULL && signal == JANET_SIGNAL_EVENT) {
|
||||
janet_vm.root_fiber->sched_id++;
|
||||
}
|
||||
#endif
|
||||
if (signal != JANET_SIGNAL_ERROR) {
|
||||
*janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal]));
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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,21 +67,11 @@ extern "C" {
|
||||
#define JANET_LINUX 1
|
||||
#endif
|
||||
|
||||
/* Check for Android */
|
||||
#ifdef __ANDROID__
|
||||
#define JANET_ANDROID 1
|
||||
#endif
|
||||
|
||||
/* Check for Cygwin */
|
||||
#if defined(__CYGWIN__)
|
||||
#define JANET_CYGWIN 1
|
||||
#endif
|
||||
|
||||
/* Check for Illumos */
|
||||
#if defined(__illumos__)
|
||||
#define JANET_ILLUMOS 1
|
||||
#endif
|
||||
|
||||
/* Check Unix */
|
||||
#if defined(_AIX) \
|
||||
|| defined(__APPLE__) /* Darwin */ \
|
||||
@@ -167,7 +157,7 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/* Check sun */
|
||||
#if defined(__sun) && !defined(JANET_ILLUMOS)
|
||||
#ifdef __sun
|
||||
#define JANET_NO_UTC_MKTIME
|
||||
#endif
|
||||
|
||||
@@ -175,12 +165,14 @@ extern "C" {
|
||||
/* Also enable the thread library only if not single-threaded */
|
||||
#ifdef JANET_SINGLE_THREADED
|
||||
#define JANET_THREAD_LOCAL
|
||||
#elif !(defined(JANET_THREAD_LOCAL)) && defined(__GNUC__)
|
||||
#undef JANET_THREADS
|
||||
#elif defined(__GNUC__)
|
||||
#define JANET_THREAD_LOCAL __thread
|
||||
#elif !(defined(JANET_THREAD_LOCAL)) && defined(_MSC_BUILD)
|
||||
#elif defined(_MSC_BUILD)
|
||||
#define JANET_THREAD_LOCAL __declspec(thread)
|
||||
#elif !(defined(JANET_THREAD_LOCAL))
|
||||
#else
|
||||
#define JANET_THREAD_LOCAL
|
||||
#undef JANET_THREADS
|
||||
#endif
|
||||
|
||||
/* Enable or disable dynamic module loading. Enabled by default. */
|
||||
@@ -599,7 +591,6 @@ typedef void *JanetAbstract;
|
||||
#define JANET_STREAM_WRITABLE 0x400
|
||||
#define JANET_STREAM_ACCEPTABLE 0x800
|
||||
#define JANET_STREAM_UDPSERVER 0x1000
|
||||
#define JANET_STREAM_NOT_CLOSEABLE 0x2000
|
||||
#define JANET_STREAM_TOCLOSE 0x10000
|
||||
|
||||
typedef enum {
|
||||
@@ -672,7 +663,6 @@ typedef int32_t JanetAtomicInt;
|
||||
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_load_relaxed(JanetAtomicInt volatile *x);
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
@@ -1188,7 +1178,6 @@ struct JanetAbstractType {
|
||||
Janet(*call)(void *p, int32_t argc, Janet *argv);
|
||||
size_t (*length)(void *p, size_t len);
|
||||
JanetByteView(*bytes)(void *p, size_t len);
|
||||
int (*gcperthread)(void *data, size_t len);
|
||||
};
|
||||
|
||||
/* Some macros to let us add extra types to JanetAbstract types without
|
||||
@@ -1208,8 +1197,7 @@ struct JanetAbstractType {
|
||||
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH
|
||||
#define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES
|
||||
#define JANET_ATEND_BYTES NULL,JANET_ATEND_GCPERTHREAD
|
||||
#define JANET_ATEND_GCPERTHREAD
|
||||
#define JANET_ATEND_BYTES
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
@@ -1467,10 +1455,10 @@ JANET_API int32_t janet_abstract_incref(void *abst);
|
||||
JANET_API int32_t janet_abstract_decref(void *abst);
|
||||
|
||||
/* Expose channel utilities */
|
||||
JANET_API JanetChannel *janet_channel_make(uint32_t limit);
|
||||
JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit);
|
||||
JANET_API JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
|
||||
JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt);
|
||||
JanetChannel *janet_channel_make(uint32_t limit);
|
||||
JanetChannel *janet_channel_make_threaded(uint32_t limit);
|
||||
JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
|
||||
JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt);
|
||||
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
|
||||
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
|
||||
|
||||
@@ -1618,9 +1606,6 @@ JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||
|
||||
/* Execute strings */
|
||||
#define JANET_DO_ERROR_RUNTIME 0x01
|
||||
#define JANET_DO_ERROR_COMPILE 0x02
|
||||
#define JANET_DO_ERROR_PARSE 0x04
|
||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
|
||||
@@ -1899,7 +1884,6 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
|
||||
#define JANET_SANDBOX_FFI_USE 2048
|
||||
#define JANET_SANDBOX_FFI_JIT 4096
|
||||
#define JANET_SANDBOX_SIGNAL 8192
|
||||
#define JANET_SANDBOX_CHROOT 16384
|
||||
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
||||
#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)
|
||||
@@ -2198,7 +2182,6 @@ typedef enum {
|
||||
RULE_UNREF, /* [rule, tag] */
|
||||
RULE_CAPTURE_NUM, /* [rule, tag] */
|
||||
RULE_SUB, /* [rule, rule] */
|
||||
RULE_TIL, /* [rule, rule] */
|
||||
RULE_SPLIT, /* [rule, rule] */
|
||||
RULE_NTH, /* [nth, rule, tag] */
|
||||
RULE_ONLY_TAGS, /* [rule] */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
* Copyright (c) 2024 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -27,7 +27,7 @@
|
||||
(if x
|
||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
||||
(do
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (string e) x) (eflush)))
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
x)
|
||||
|
||||
(defn skip-asserts
|
||||
@@ -39,7 +39,7 @@
|
||||
(defmacro assert
|
||||
[x &opt e]
|
||||
(def xx (gensym))
|
||||
(default e (string/format "%j" x))
|
||||
(default e ~',x)
|
||||
~(do
|
||||
(def ,xx ,x)
|
||||
(,assert-no-tail ,xx ,e)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2025 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) 2025 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) 2025 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
|
||||
@@ -865,13 +865,6 @@
|
||||
(assert (deep= ~(,import* "a" :as "b" :fresh maybe)
|
||||
(macex '(import a :as b :fresh maybe))) "import macro 2")
|
||||
|
||||
# 2af3f21d
|
||||
(assert-error "import macro 2" (macex '(import a :fresh)))
|
||||
(assert-error "import macro 3" (macex '(import a :as b :fresh)))
|
||||
(assert-error "import macro 4" (macex '(import b "notakeyword" value)))
|
||||
(assert (deep= ~(,import* "a" :fresh nil)
|
||||
(macex '(import a :fresh nil))) "import macro 5")
|
||||
|
||||
# #477 walk preserving bracket type
|
||||
# 0a1d902f4
|
||||
(assert (= :brackets (tuple/type (postwalk identity '[])))
|
||||
@@ -903,18 +896,11 @@
|
||||
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
|
||||
(table/setproto table-to-freeze @{:a @[1 2 3]})
|
||||
|
||||
(assert (deep= struct-to-thaw (freeze table-to-freeze)))
|
||||
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
|
||||
(freeze table-to-freeze)))
|
||||
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
|
||||
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
|
||||
|
||||
# Check that freezing mutable keys is deterministic
|
||||
# for issue #1535
|
||||
(def hashes @{})
|
||||
(repeat 200
|
||||
(def x (freeze {@"" 1 @"" 2 @"" 3 @"" 4 @"" 5}))
|
||||
(put hashes (hash x) true))
|
||||
(assert (= 1 (length hashes)) "freeze mutable keys is deterministic")
|
||||
|
||||
# Make sure Carriage Returns don't end up in doc strings
|
||||
# e528b86
|
||||
(assert (not (string/find "\r"
|
||||
@@ -990,17 +976,6 @@
|
||||
(assert (= () '() (macex '())) "macex ()")
|
||||
(assert (= '[] (macex '[])) "macex []")
|
||||
|
||||
# Knuth man or boy test
|
||||
(var a nil)
|
||||
(defn man-or-boy [x] (a x |1 |-1 |-1 |1 |0))
|
||||
(varfn a [k x1 x2 x3 x4 x5]
|
||||
(var k k)
|
||||
(defn b [] (-- k) (a k b x1 x2 x3 x4))
|
||||
(if (<= k 0)
|
||||
(+ (x4) (x5))
|
||||
(b)))
|
||||
(assert (= -2 (man-or-boy 2)))
|
||||
(assert (= -67 (man-or-boy 10)))
|
||||
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
|
||||
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
|
||||
|
||||
@@ -1026,12 +1001,8 @@
|
||||
@{:key1 "value1" @"key" "value2"}) "deep= mutable keys"))
|
||||
(assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key")
|
||||
(assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys")
|
||||
(assert (deep-not= {@"" @"" @"" @"" @"" 3} {@"" @"" @"" @"" @"" 3}) "deep= duplicate mutable keys 2")
|
||||
(assert (deep-not= {@[] @"" @[] @"" @[] 3} {@[] @"" @[] @"" @[] 3}) "deep= duplicate mutable keys 3")
|
||||
(assert (deep-not= {@{} @"" @{} @"" @{} 3} {@{} @"" @{} @"" @{} 3}) "deep= duplicate mutable keys 4")
|
||||
(assert (deep-not= @{:key1 "value1" @"key2" @"value2"}
|
||||
@{:key1 "value1" @"key2" "value2"}) "deep= mutable keys")
|
||||
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
|
||||
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
|
||||
(def k1 @"")
|
||||
(def k2 @"")
|
||||
(assert (deep= {k1 1 k2 2} {k1 1 k2 2}) "deep= duplicate mutable keys 2")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
# Copyright (c) 2024 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) 2025 Calvin Rose
|
||||
# Copyright (c) 2024 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) 2025 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) 2025 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) 2025 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
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user