mirror of
https://github.com/janet-lang/janet
synced 2026-04-07 07:21:26 +00:00
Compare commits
100 Commits
v1.40.1
...
compile-op
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ead0ed5d41 | ||
|
|
42bc504188 | ||
|
|
c3317905a1 | ||
|
|
0066a5a304 | ||
|
|
3dd6e744de | ||
|
|
862b4e9688 | ||
|
|
c9305a0a42 | ||
|
|
3cbdf26aa2 | ||
|
|
11e6a5a315 | ||
|
|
871f8ebf4e | ||
|
|
c677c72a73 | ||
|
|
af73e214b2 | ||
|
|
a6e0a8228c | ||
|
|
9a1cd6fdd9 | ||
|
|
768c9b23e1 | ||
|
|
059253fdee | ||
|
|
4396f01297 | ||
|
|
046d299d77 | ||
|
|
9fa9286fca | ||
|
|
c13ef02ea2 | ||
|
|
52cedbc4b4 | ||
|
|
d345e551f1 | ||
|
|
0fb1773c19 | ||
|
|
a6ea38a23b | ||
|
|
bc79489068 | ||
|
|
b096babcbf | ||
|
|
bed80bf1d3 | ||
|
|
80ed6538d0 | ||
|
|
6577a18cef | ||
|
|
731592a80e | ||
|
|
ea332ff81e | ||
|
|
f36d544deb | ||
|
|
e96dd512f3 | ||
|
|
a588f1f242 | ||
|
|
ae15eadfaf | ||
|
|
3618b72f4d | ||
|
|
3510e235ee | ||
|
|
b6fb7ae69c | ||
|
|
e5765b26d4 | ||
|
|
cdb3baaca3 | ||
|
|
c413bc2b4e | ||
|
|
dfdf734fc7 | ||
|
|
314e684097 | ||
|
|
232a8faa35 | ||
|
|
c31d8b52ff | ||
|
|
f0395763b7 | ||
|
|
5b3c5a5969 | ||
|
|
af10c1d4b5 | ||
|
|
3995fa86e2 | ||
|
|
9d7a279999 | ||
|
|
3e273ce03a | ||
|
|
25b7c74089 | ||
|
|
9e47cd94bd | ||
|
|
7ea118f248 | ||
|
|
480c5b5e9d | ||
|
|
8a394f2506 | ||
|
|
2c208f5d01 | ||
|
|
08e6051af8 | ||
|
|
19212e6f5c | ||
|
|
8875adf69e | ||
|
|
745567a2e0 | ||
|
|
ef2dfcd7c3 | ||
|
|
f582fe1f69 | ||
|
|
3cc3312b7b | ||
|
|
f2d25a0da2 | ||
|
|
dfd05ddf7e | ||
|
|
31be7bad8e | ||
|
|
3a782d27b1 | ||
|
|
f08874e65e | ||
|
|
6a78b6d1c6 | ||
|
|
97963d1396 | ||
|
|
efbc46c69e | ||
|
|
9b9f67c371 | ||
|
|
61791e4a4c | ||
|
|
c3a4fb6735 | ||
|
|
e5893d0692 | ||
|
|
5f5e5cf693 | ||
|
|
46bda4e6fa | ||
|
|
fdbf4f2666 | ||
|
|
b939671b79 | ||
|
|
4b8e7a416f | ||
|
|
1e1e7a5cfd | ||
|
|
91e459e4a5 | ||
|
|
b6adc257f4 | ||
|
|
a2bd98390e | ||
|
|
d9912f38f8 | ||
|
|
8007806c8e | ||
|
|
de2440d458 | ||
|
|
43ab06467f | ||
|
|
3fe4cfd14c | ||
|
|
75be5fd4c6 | ||
|
|
7c7136fd70 | ||
|
|
cfa32d58a7 | ||
|
|
7cc176f0c0 | ||
|
|
4d7baef89e | ||
|
|
29af4a932d | ||
|
|
ef94a0f0b4 | ||
|
|
517dc208ca | ||
|
|
fd7579dd07 | ||
|
|
6b74400f2a |
@@ -1,4 +1,4 @@
|
||||
image: openbsd/7.7
|
||||
image: openbsd/7.6
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
@@ -10,17 +10,13 @@ tasks:
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
doas gmake uninstall
|
||||
- meson_min: |
|
||||
cd janet
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
|
||||
cd build_meson_min
|
||||
ninja
|
||||
- meson_reduced: |
|
||||
cd janet
|
||||
meson setup build_meson_reduced --buildtype=release -Dreduced_os=true
|
||||
cd build_meson_reduced
|
||||
ninja
|
||||
- meson_prf: |
|
||||
cd janet
|
||||
meson setup build_meson_prf --buildtype=release -Dprf=true
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -37,6 +37,7 @@ temp.janet
|
||||
temp.c
|
||||
temp*janet
|
||||
temp*.c
|
||||
temp.*
|
||||
scratch.janet
|
||||
scratch.c
|
||||
|
||||
|
||||
@@ -1,11 +1,7 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.40.1 - 2025-11-16
|
||||
- Fix `JANET_REDUCED_OS` build regression caused by `os/posix-chroot`.
|
||||
- Code formatting
|
||||
|
||||
## 1.40.0 - 2025-11-15
|
||||
## 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`.
|
||||
|
||||
@@ -61,7 +61,7 @@ ensure a consistent code style for C.
|
||||
|
||||
## Janet style
|
||||
|
||||
All janet code in the project should be formatted similar to the code in src/boot/boot.janet.
|
||||
All janet code in the project should be formatted similar to the code in core.janet.
|
||||
The auto formatting from janet.vim will work well.
|
||||
|
||||
## Typo Fixing and One-Line changes
|
||||
|
||||
46
Makefile
46
Makefile
@@ -53,7 +53,7 @@ STRIPFLAGS=-x -S
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
# Symbols are (optionally) removed later, keep -g as default!
|
||||
CFLAGS?=-O2 -g
|
||||
CFLAGS?=-O0 -g
|
||||
LDFLAGS?=-rdynamic
|
||||
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
||||
RUN:=$(RUN)
|
||||
@@ -138,7 +138,8 @@ 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/symcache.h \
|
||||
src/core/sysir.h
|
||||
|
||||
JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/array.c \
|
||||
@@ -173,6 +174,9 @@ 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 \
|
||||
@@ -261,7 +265,6 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
|
||||
# Testing assumes HOSTCC=CC
|
||||
|
||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||
EXAMPLE_SCRIPTS=$(wildcard examples/*.janet)
|
||||
|
||||
repl: $(JANET_TARGET)
|
||||
$(RUN) ./$(JANET_TARGET)
|
||||
@@ -269,26 +272,21 @@ repl: $(JANET_TARGET)
|
||||
debug: $(JANET_TARGET)
|
||||
$(DEBUGGER) ./$(JANET_TARGET)
|
||||
|
||||
VALGRIND_COMMAND=$(RUN) valgrind --leak-check=full --quiet
|
||||
CALLGRIND_COMMAND=$(RUN) valgrind --tool=callgrind
|
||||
VALGRIND_COMMAND=valgrind --leak-check=full --quiet
|
||||
|
||||
valgrind: $(JANET_TARGET)
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||
|
||||
test: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
$(CALLGRIND_COMMAND) ./$(JANET_TARGET)
|
||||
|
||||
calltest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
|
||||
for f in test/suite*.janet; do $(CALLGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do $(CALLGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
########################
|
||||
##### Distribution #####
|
||||
@@ -347,7 +345,6 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
$(eval JANET_VERSION := $(shell $(JANET_TARGET) -e '(print janet/version)'))
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip $(STRIPFLAGS) '$(DESTDIR)$(BINDIR)/janet'
|
||||
@@ -357,13 +354,13 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
if test $(UNAME) = Darwin ; then \
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(JANET_VERSION).dylib' ; \
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
|
||||
ln -sf libjanet.$(JANET_VERSION).dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
||||
ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
||||
else \
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(JANET_VERSION)' ; \
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
|
||||
ln -sf libjanet.so.$(JANET_VERSION) $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
||||
fi
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
||||
@@ -420,6 +417,9 @@ clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
|
||||
test-install:
|
||||
echo "JPM has been removed from default install."
|
||||
|
||||
help:
|
||||
@echo
|
||||
@echo 'Janet: A Dynamic Language & Bytecode VM'
|
||||
@@ -431,8 +431,7 @@ help:
|
||||
@echo ' make test Test a built Janet'
|
||||
@echo ' make valgrind Assess Janet with Valgrind'
|
||||
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
|
||||
@echo ' make valtest Run the test suite and examples with Valgrind to check for memory leaks'
|
||||
@echo ' make calltest Run the test suite and examples with Callgrind'
|
||||
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
|
||||
@echo ' make dist Create a distribution tarball'
|
||||
@echo ' make docs Generate documentation'
|
||||
@echo ' make debug Run janet with GDB or LLDB'
|
||||
@@ -442,9 +441,6 @@ help:
|
||||
@echo " make format Format Janet's own source files"
|
||||
@echo ' make grammar Generate a TextMate language grammar'
|
||||
@echo
|
||||
@echo ' make install-jpm-git Install jpm into the current filesystem'
|
||||
@echo ' make install-spork-git Install spork into the current filesystem'
|
||||
@echo
|
||||
|
||||
.PHONY: clean install install-jpm-git install-spork-git repl debug valgrind test \
|
||||
valtest callgrind callgrind-test dist uninstall docs grammar format help compile-commands
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest dist uninstall docs grammar format help compile-commands
|
||||
|
||||
@@ -20,11 +20,11 @@
|
||||
@setlocal
|
||||
|
||||
@rem Example use asan
|
||||
@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
|
||||
@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
|
||||
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||
@set JANET_LINK=link /nologo
|
||||
@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_LINK_STATIC=lib /nologo
|
||||
|
||||
@@ -49,7 +49,7 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@rem note that there is no default syspath being baked in
|
||||
@rem note that there is no default sysroot being baked in
|
||||
build\janet_boot . > build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
|
||||
@@ -1,3 +0,0 @@
|
||||
@{
|
||||
:name "sample-bad-bundle1"
|
||||
}
|
||||
@@ -1,3 +0,0 @@
|
||||
@{
|
||||
:name "sample-bad-bundle2"
|
||||
}
|
||||
71
examples/sysir/drawing.janet
Normal file
71
examples/sysir/drawing.janet
Normal file
@@ -0,0 +1,71 @@
|
||||
###
|
||||
### 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)
|
||||
86
examples/sysir/drawing2.janet
Normal file
86
examples/sysir/drawing2.janet
Normal file
@@ -0,0 +1,86 @@
|
||||
###
|
||||
### 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)
|
||||
567
examples/sysir/frontend.janet
Normal file
567
examples/sysir/frontend.janet
Normal file
@@ -0,0 +1,567 @@
|
||||
# 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))])
|
||||
16
examples/sysir/hello.janet
Normal file
16
examples/sysir/hello.janet
Normal file
@@ -0,0 +1,16 @@
|
||||
(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)))
|
||||
5
examples/sysir/run_drawing.sh
Executable file
5
examples/sysir/run_drawing.sh
Executable file
@@ -0,0 +1,5 @@
|
||||
#!/usr/bin/env bash
|
||||
valgrind build/janet examples/sysir/drawing.janet > temp.c
|
||||
cc temp.c
|
||||
./a.out > temp.bmp
|
||||
feh temp.bmp
|
||||
5
examples/sysir/run_drawing2.sh
Executable file
5
examples/sysir/run_drawing2.sh
Executable file
@@ -0,0 +1,5 @@
|
||||
#!/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
|
||||
4
examples/sysir/run_samples.bat
Normal file
4
examples/sysir/run_samples.bat
Normal file
@@ -0,0 +1,4 @@
|
||||
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
|
||||
5
examples/sysir/run_samples.sh
Executable file
5
examples/sysir/run_samples.sh
Executable file
@@ -0,0 +1,5 @@
|
||||
#!/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
|
||||
72
examples/sysir/samples.janet
Normal file
72
examples/sysir/samples.janet
Normal file
@@ -0,0 +1,72 @@
|
||||
(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)
|
||||
10
examples/sysir/typeerr1.janet
Normal file
10
examples/sysir/typeerr1.janet
Normal file
@@ -0,0 +1,10 @@
|
||||
(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))
|
||||
14
examples/sysir/windows_samples.janet
Normal file
14
examples/sysir/windows_samples.janet
Normal file
@@ -0,0 +1,14 @@
|
||||
(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)
|
||||
24
examples/sysir/x64.janet
Normal file
24
examples/sysir/x64.janet
Normal file
@@ -0,0 +1,24 @@
|
||||
(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)))
|
||||
@@ -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.1')
|
||||
version : '1.40.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -126,7 +126,8 @@ core_headers = [
|
||||
'src/core/regalloc.h',
|
||||
'src/core/compile.h',
|
||||
'src/core/emit.h',
|
||||
'src/core/symcache.h'
|
||||
'src/core/symcache.h',
|
||||
'src/core/sysir.h',
|
||||
]
|
||||
|
||||
core_src = [
|
||||
@@ -163,6 +164,9 @@ 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',
|
||||
@@ -297,6 +301,7 @@ 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',
|
||||
|
||||
@@ -348,15 +348,12 @@
|
||||
[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 (gensym)
|
||||
f (gensym)]
|
||||
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
|
||||
,(if err ~(def ,err ,r))
|
||||
,(if fib ~(def ,fib ,f))
|
||||
,;(tuple/slice catch 1))
|
||||
(do ,;(tuple/slice catch 1))
|
||||
,r))))
|
||||
|
||||
(defmacro with-syms
|
||||
@@ -1806,8 +1803,8 @@
|
||||
(flatten-into @[] xs))
|
||||
|
||||
(defn kvs
|
||||
``Takes a table or struct and returns a new array of key value pairs
|
||||
like `@[k v k v ...]`.``
|
||||
``Takes a table or struct and returns and array of key value pairs
|
||||
like `@[k v k v ...]`. Returns a new array.``
|
||||
[dict]
|
||||
(def ret @[])
|
||||
(loop [k :keys dict] (array/push ret k (in dict k)))
|
||||
@@ -2295,8 +2292,8 @@
|
||||
|
||||
(defn thaw
|
||||
`Thaw an object (make it mutable) and do a deep copy, making
|
||||
child value also mutable. Closures, fibers, and abstract
|
||||
types will not be recursively thawed, but all other types will`
|
||||
child values 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)
|
||||
@@ -4197,7 +4194,7 @@
|
||||
(spit manifest-name b))
|
||||
|
||||
(defn bundle/manifest
|
||||
"Get the manifest for a given installed bundle."
|
||||
"Get the manifest for a give installed bundle"
|
||||
[bundle-name]
|
||||
(def name (get-manifest-filename bundle-name))
|
||||
(assertf (fexists name) "no bundle %v found" bundle-name)
|
||||
@@ -4222,9 +4219,7 @@
|
||||
(put new-env *syspath* fixed-syspath)
|
||||
(with-env new-env
|
||||
(put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right
|
||||
(try
|
||||
(require (string "@syspath/bundle/" bundle-name))
|
||||
([_] (error "bundle must contain bundle.janet or bundle/init.janet"))))))
|
||||
(require (string "@syspath/bundle/" bundle-name)))))
|
||||
|
||||
(defn- do-hook
|
||||
[module bundle-name hook & args]
|
||||
@@ -4261,9 +4256,7 @@
|
||||
nil)
|
||||
|
||||
(defn bundle/uninstall
|
||||
``Remove a bundle from the current syspath. There is 1 hook called during
|
||||
uninstallation (uninstall). A user can register a hook by defining a
|
||||
function with the same name in the bundle script.``
|
||||
"Remove a bundle from the current syspath"
|
||||
[bundle-name]
|
||||
(def breakage @{})
|
||||
(each b (bundle/list)
|
||||
@@ -4299,8 +4292,8 @@
|
||||
order)
|
||||
|
||||
(defn bundle/prune
|
||||
``Remove all orphaned bundles from the current syspath. An orphaned bundle is a
|
||||
bundle that is marked for :auto-remove and is not depended on by any other bundle.``
|
||||
"Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is
|
||||
marked for :auto-remove and is not depended on by any other bundle."
|
||||
[]
|
||||
(def topo (bundle/topolist))
|
||||
(def rtopo (reverse topo))
|
||||
@@ -4329,44 +4322,33 @@
|
||||
(not (not (os/stat (bundle-dir bundle-name) :mode))))
|
||||
|
||||
(defn bundle/install
|
||||
``Install a bundle from the local filesystem. The name of the bundle is
|
||||
the value mapped to :name in either `config` or the info file. There are
|
||||
5 hooks called during installation (postdeps, clean, build, install and
|
||||
check). A user can register a hook by defining a function with the same name
|
||||
in the bundle script.``
|
||||
"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 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
|
||||
(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)))
|
||||
(assertf bundle-name
|
||||
"unable to infer bundle name for %v, use :name argument or add :name to info file" path)
|
||||
(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)
|
||||
# Check bscript
|
||||
(def bscript-src1 (string path s "bundle" s "init.janet"))
|
||||
(def bscript-src2 (string path s "bundle.janet"))
|
||||
(def bscript-src (cond
|
||||
(fexists bscript-src1) bscript-src1
|
||||
(fexists bscript-src2) bscript-src2))
|
||||
# Setup installed paths
|
||||
(prime-bundle-paths)
|
||||
(os/mkdir (bundle-dir bundle-name))
|
||||
# Copy aliased infofile
|
||||
(when (fexists infofile-src2)
|
||||
(copyfile infofile-src2 (bundle-file bundle-name "info.jdn")))
|
||||
# Copy aliased bscript
|
||||
(when (fexists bscript-src2)
|
||||
(copyfile bscript-src2 (bundle-file bundle-name "init.janet")))
|
||||
# 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))
|
||||
# Copy some files into the new location unconditionally
|
||||
(def implicit-sources (string path s "bundle"))
|
||||
(when (= :directory (os/stat implicit-sources :mode))
|
||||
@@ -4375,7 +4357,8 @@
|
||||
(merge-into man config)
|
||||
(sync-manifest man)
|
||||
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
|
||||
(when info
|
||||
(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))))
|
||||
(def missing (filter (complement bundle/installed?) deps))
|
||||
@@ -4383,13 +4366,12 @@
|
||||
(error (string "missing dependencies " (string/join missing ", "))))
|
||||
(put man :dependencies deps)
|
||||
(put man :info info))
|
||||
(def module (get-bundle-module bundle-name))
|
||||
(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)
|
||||
(do-hook module bundle-name :dependencies man) # deprecated, use :postdeps
|
||||
(do-hook module bundle-name :postdeps man)
|
||||
(do-hook module bundle-name :dependencies man)
|
||||
(when clean
|
||||
(do-hook module bundle-name :clean man))
|
||||
(do-hook module bundle-name :build man)
|
||||
@@ -4399,21 +4381,15 @@
|
||||
(when check
|
||||
(do-hook module bundle-name :check man)))
|
||||
(print "installed " bundle-name)
|
||||
(when (or (get man :has-exe)
|
||||
# remove eventually
|
||||
(get man :has-bin-script))
|
||||
(when (get man :has-bin-script)
|
||||
(def binpath (string (dyn *syspath*) s "bin"))
|
||||
(eprintf "executable files have been installed to %s" binpath))
|
||||
(when (get man :has-man)
|
||||
(def manpath (string (dyn *syspath*) s "man"))
|
||||
(eprintf "man pages have been installed to %s" manpath))
|
||||
(eprintf "executable scripts have been installed to %s" binpath))
|
||||
bundle-name)
|
||||
|
||||
(defn- bundle/pack
|
||||
``Take an installed bundle and create a bundle source directory that can be
|
||||
used to reinstall the bundle on a compatible system. This is used to create
|
||||
backups for installed bundles without rebuilding, or make a prebuilt bundle
|
||||
for other systems.``
|
||||
"Take an installed bundle and create a bundle source directory that can be used to
|
||||
reinstall the bundle on a compatible system. This is used to create backups for installed
|
||||
bundles without rebuilding, or make a prebuilt bundle for other systems."
|
||||
[bundle-name dest-dir &opt is-backup]
|
||||
(var i 0)
|
||||
(def man (bundle/manifest bundle-name))
|
||||
@@ -4443,9 +4419,9 @@
|
||||
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 necessary to replace a package without breaking any dependencies.``
|
||||
"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]
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def config (get manifest :config @{}))
|
||||
@@ -4472,7 +4448,7 @@
|
||||
bundle-name)
|
||||
|
||||
(defn bundle/add-directory
|
||||
"Add a directory during an install relative to `(dyn *syspath*)`."
|
||||
"Add a directory during the install process relative to `(dyn *syspath*)`"
|
||||
[manifest dest &opt chmod-mode]
|
||||
(def files (get-files manifest))
|
||||
(def s (sep))
|
||||
@@ -4500,7 +4476,7 @@
|
||||
ret)
|
||||
|
||||
(defn bundle/add-file
|
||||
"Add a file during an install relative to `(dyn *syspath*)`."
|
||||
"Add files during an install relative to `(dyn *syspath*)`"
|
||||
[manifest src &opt dest chmod-mode]
|
||||
(default dest src)
|
||||
(def files (get-files manifest))
|
||||
@@ -4517,9 +4493,9 @@
|
||||
absdest)
|
||||
|
||||
(defn bundle/add
|
||||
``Add a file or directory during an install relative to `(dyn *syspath*)`.
|
||||
Added files and directories will be recorded in the bundle manifest such
|
||||
that they are properly tracked and removed during an upgrade or uninstall.``
|
||||
"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
|
||||
and removed during an upgrade or uninstall."
|
||||
[manifest src &opt dest chmod-mode]
|
||||
(default dest src)
|
||||
(def s (sep))
|
||||
@@ -4534,31 +4510,20 @@
|
||||
(errorf "bad path %s - file is a %s" src mode)))
|
||||
|
||||
(defn bundle/add-bin
|
||||
``Add a file to the "bin" subdirectory of the current syspath. By default,
|
||||
files will be set to be executable.``
|
||||
[manifest src &opt filename chmod-mode]
|
||||
``
|
||||
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 filename (last (string/split s src)))
|
||||
(default dest (last (string/split s src)))
|
||||
(default chmod-mode 8r755)
|
||||
(os/mkdir (string (dyn *syspath*) s "bin"))
|
||||
(put manifest :has-exe true)
|
||||
(put manifest :has-bin-script true) # remove eventually
|
||||
(bundle/add-file manifest src (string "bin" s filename) chmod-mode))
|
||||
|
||||
(defn bundle/add-manpage
|
||||
``Add a file to the man subdirectory of the current syspath. Files are
|
||||
copied inside a directory `mansec`. By default, `mansec` is "man1".``
|
||||
[manifest src &opt mansec]
|
||||
(def s (sep))
|
||||
(default mansec "man1")
|
||||
(def filename (last (string/split s src)))
|
||||
(os/mkdir (string (dyn *syspath*) s "man"))
|
||||
(os/mkdir (string (dyn *syspath*) s "man" s mansec))
|
||||
(put manifest :has-man true)
|
||||
(bundle/add-file manifest src (string "man" s mansec s filename)))
|
||||
(put manifest :has-bin-script true)
|
||||
(bundle/add-file manifest src (string "bin" s dest) chmod-mode))
|
||||
|
||||
(defn bundle/update-all
|
||||
"Reinstall all bundles."
|
||||
"Reinstall all bundles"
|
||||
[&keys configs]
|
||||
(each bundle (bundle/topolist)
|
||||
(bundle/reinstall bundle ;(kvs configs)))))
|
||||
@@ -4570,10 +4535,7 @@
|
||||
###
|
||||
|
||||
# conditional compilation for reduced os
|
||||
(def- getenv-raw (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
|
||||
(defn- getenv-alias [env-var &opt dflt]
|
||||
(def x (getenv-raw env-var dflt))
|
||||
(if (= x "") nil x)) # empty string is coerced to nil
|
||||
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
|
||||
|
||||
(defn- run-main
|
||||
[env subargs arg]
|
||||
@@ -4903,7 +4865,8 @@
|
||||
"src/core/regalloc.h"
|
||||
"src/core/compile.h"
|
||||
"src/core/emit.h"
|
||||
"src/core/symcache.h"])
|
||||
"src/core/symcache.h"
|
||||
"src/core/sysir.h"])
|
||||
|
||||
(def core-sources
|
||||
["src/core/abstract.c"
|
||||
@@ -4939,6 +4902,9 @@
|
||||
"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"
|
||||
@@ -4948,15 +4914,14 @@
|
||||
"src/core/wrap.c"])
|
||||
|
||||
# Print janet.c to stdout
|
||||
(def image-only (has-value? boot/args "image-only"))
|
||||
(print "/* " (if image-only "Image-only" "Amalgamated") " build - DO NOT EDIT */")
|
||||
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||
(print "/* Generated from janet version " janet/version "-" janet/build " */")
|
||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||
(print ```#define JANET_AMALG```)
|
||||
|
||||
(defn do-one-file
|
||||
[fname]
|
||||
(unless image-only
|
||||
(unless (has-value? boot/args "image-only")
|
||||
(print "\n/* " fname " */")
|
||||
(print "#line 0 \"" fname "\"\n")
|
||||
(def source (slurp fname))
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 40
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.40.1"
|
||||
#define JANET_VERSION "1.40.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -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_panic("cannot release lock");
|
||||
if (ret) janet_panicf("cannot release lock: %s", strerror(ret));
|
||||
}
|
||||
|
||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||
|
||||
@@ -1127,4 +1127,5 @@ void janet_lib_compile(JanetTable *env) {
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
janet_lib_sysir(env);
|
||||
}
|
||||
|
||||
@@ -268,6 +268,9 @@ 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);
|
||||
|
||||
@@ -997,11 +997,11 @@ 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 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."));
|
||||
}
|
||||
|
||||
static const uint32_t error_asm[] = {
|
||||
@@ -1154,82 +1154,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if the data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if the data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
janet_quick_asm(env, JANET_FUN_PROP,
|
||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||
JDOC("(propagate x fiber)\n\n"
|
||||
"Propagate a signal from a fiber to the current fiber and "
|
||||
"set the last value of the current fiber to `x`. The signal "
|
||||
"value is then available as the status of the current fiber. "
|
||||
"The resulting stack trace from the current fiber will include "
|
||||
"frames from fiber. If fiber is in a state that can be resumed, "
|
||||
"resuming the current fiber will first resume `fiber`. "
|
||||
"This function can be used to re-raise an error without losing "
|
||||
"the original stack trace."));
|
||||
"Propagate a signal from a fiber to the current fiber and "
|
||||
"set the last value of the current fiber to `x`. The signal "
|
||||
"value is then available as the status of the current fiber. "
|
||||
"The resulting stack trace from the current fiber will include "
|
||||
"frames from fiber. If fiber is in a state that can be resumed, "
|
||||
"resuming the current fiber will first resume `fiber`. "
|
||||
"This function can be used to re-raise an error without losing "
|
||||
"the original stack trace."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns the value passed in by resume."));
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns the value passed in by resume."));
|
||||
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||
JDOC("(error e)\n\n"
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
||||
JDOC("(yield &opt x)\n\n"
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_CANCEL,
|
||||
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
|
||||
JDOC("(cancel fiber err)\n\n"
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber &opt x)\n\n"
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_IN,
|
||||
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
|
||||
JDOC("(in ds key &opt dflt)\n\n"
|
||||
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
|
||||
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
|
||||
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
|
||||
"take any value as a key except nil and will return nil or dflt if not found."));
|
||||
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
|
||||
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
|
||||
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
|
||||
"take any value as a key except nil and will return nil or dflt if not found."));
|
||||
janet_quick_asm(env, JANET_FUN_GET,
|
||||
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
|
||||
JDOC("(get ds key &opt dflt)\n\n"
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to in, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error."));
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to in, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error."));
|
||||
janet_quick_asm(env, JANET_FUN_PUT,
|
||||
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||
JDOC("(put ds key value)\n\n"
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||
janet_quick_asm(env, JANET_FUN_LENGTH,
|
||||
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
|
||||
JDOC("(length ds)\n\n"
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||
janet_quick_asm(env, JANET_FUN_BNOT,
|
||||
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
||||
@@ -1238,74 +1238,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Variadic ops */
|
||||
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
|
||||
JDOC("(+ & xs)\n\n"
|
||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
||||
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
|
||||
JDOC("(- & xs)\n\n"
|
||||
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
||||
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
||||
"the rest of the elements."));
|
||||
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
||||
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
||||
"the rest of the elements."));
|
||||
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
|
||||
JDOC("(* & xs)\n\n"
|
||||
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
||||
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
||||
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
|
||||
JDOC("(div & xs)\n\n"
|
||||
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
|
||||
JDOC("(mod & xs)\n\n"
|
||||
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
|
||||
"`(mod x 0)` is defined to be `x`."));
|
||||
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
|
||||
"`(mod x 0)` is defined to be `x`."));
|
||||
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
|
||||
JDOC("(% & xs)\n\n"
|
||||
"Returns the remainder of dividing the first value of xs by each remaining value."));
|
||||
"Returns the remainder of dividing the first value of xs by each remaining value."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
|
||||
JDOC("(bor & xs)\n\n"
|
||||
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
||||
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
|
||||
JDOC("(bxor & xs)\n\n"
|
||||
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
||||
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
|
||||
JDOC("(blshift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
|
||||
JDOC("(brshift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
JDOC("(brushift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
||||
"for positive shifts the return value will always be positive."));
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
||||
"for positive shifts the return value will always be positive."));
|
||||
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
|
||||
JDOC("(> & xs)\n\n"
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
|
||||
JDOC("(< & xs)\n\n"
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
|
||||
JDOC("(>= & xs)\n\n"
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
|
||||
JDOC("(<= & xs)\n\n"
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
|
||||
/* Platform detection */
|
||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||
@@ -1314,7 +1314,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("The build identifier of the running janet program."));
|
||||
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
|
||||
JDOC("The flag set of config options from janetconf.h which is used to check "
|
||||
"if native modules are compatible with the host program."));
|
||||
"if native modules are compatible with the host program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "root-env", janet_wrap_table(env),
|
||||
|
||||
@@ -699,7 +699,7 @@ static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
|
||||
DWORD duration = (DWORD)round(tto.sec * 1000);
|
||||
DWORD res = WAIT_TIMEOUT;
|
||||
JanetTimestamp wait_end = ts_now();
|
||||
for (DWORD i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
|
||||
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();
|
||||
}
|
||||
|
||||
@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
/* Mark only the keys from a sequence of key-value pairs */
|
||||
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 a bunch of key values items in memory */
|
||||
/* Mark only the values from a sequence of key-value pairs */
|
||||
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 a bunch of key values items in memory */
|
||||
/* Mark key-value pairs */
|
||||
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
|
||||
@@ -1021,6 +1021,7 @@ 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 },
|
||||
@@ -1042,6 +1043,7 @@ 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"
|
||||
|
||||
@@ -1549,7 +1549,6 @@ JANET_CORE_FN(os_posix_chroot,
|
||||
janet_sandbox_assert(JANET_SANDBOX_CHROOT);
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argv;
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
const char *root = janet_getcstring(argv, 0);
|
||||
@@ -2872,6 +2871,7 @@ 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
|
||||
@@ -2896,7 +2896,6 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/shell", os_shell),
|
||||
JANET_CORE_REG("os/posix-fork", os_posix_fork),
|
||||
JANET_CORE_REG("os/posix-exec", os_posix_exec),
|
||||
JANET_CORE_REG("os/posix-chroot", os_posix_chroot),
|
||||
/* no need to sandbox process management if you can't create processes
|
||||
* (allows for limited functionality if use exposes C-functions to create specific processes) */
|
||||
JANET_CORE_REG("os/proc-wait", os_proc_wait),
|
||||
|
||||
@@ -60,6 +60,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
ret = janet_wrap_string(cres.error);
|
||||
int32_t line = (int32_t) parser->line;
|
||||
int32_t col = (int32_t) parser->column;
|
||||
if ((cres.error_mapping.line > 0) &&
|
||||
@@ -67,17 +68,13 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
line = cres.error_mapping.line;
|
||||
col = cres.error_mapping.column;
|
||||
}
|
||||
JanetString ctx = janet_formatc("%s:%d:%d: compile error",
|
||||
sourcePath, line, col);
|
||||
JanetString errstr = janet_formatc("%s: %s",
|
||||
(const char *)ctx,
|
||||
(const char *)cres.error);
|
||||
ret = janet_wrap_string(errstr);
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("%s", (const char *)ctx);
|
||||
janet_eprintf("%s:%d:%d: compile error", sourcePath,
|
||||
line, col);
|
||||
janet_stacktrace_ext(cres.macrofiber, ret, "");
|
||||
} else {
|
||||
janet_eprintf("%s\n", (const char *)errstr);
|
||||
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
|
||||
line, col, (const char *)cres.error);
|
||||
}
|
||||
errflags |= JANET_DO_ERROR_COMPILE;
|
||||
done = 1;
|
||||
@@ -92,14 +89,12 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_ERROR: {
|
||||
const char *e = janet_parser_error(parser);
|
||||
errflags |= JANET_DO_ERROR_PARSE;
|
||||
ret = janet_cstringv(e);
|
||||
int32_t line = (int32_t) parser->line;
|
||||
int32_t col = (int32_t) parser->column;
|
||||
JanetString errstr = janet_formatc("%s:%d:%d: parse error: %s",
|
||||
sourcePath, line, col,
|
||||
janet_parser_error(parser));
|
||||
ret = janet_wrap_string(errstr);
|
||||
janet_eprintf("%s\n", (const char *)errstr);
|
||||
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
||||
done = 1;
|
||||
break;
|
||||
}
|
||||
@@ -127,8 +122,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
janet_loop();
|
||||
if (fiber) {
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
if (!errflags)
|
||||
ret = fiber->last_value;
|
||||
ret = fiber->last_value;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
1915
src/core/sysir.c
Normal file
1915
src/core/sysir.c
Normal file
File diff suppressed because it is too large
Load Diff
337
src/core/sysir.h
Normal file
337
src/core/sysir.h
Normal file
@@ -0,0 +1,337 @@
|
||||
/*
|
||||
* 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
|
||||
376
src/core/sysir_c.c
Normal file
376
src/core/sysir_c.c
Normal file
@@ -0,0 +1,376 @@
|
||||
/*
|
||||
* 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
Normal file
1104
src/core/sysir_x86.c
Normal file
File diff suppressed because it is too large
Load Diff
@@ -322,8 +322,7 @@ int32_t janet_hash(Janet x) {
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
hash = janet_tuple_hash(janet_unwrap_tuple(x));
|
||||
uint32_t inc = (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
|
||||
hash = (int32_t)((uint32_t)hash + inc); /* avoid overflow undefined behavior */
|
||||
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
|
||||
@@ -147,7 +147,6 @@ extern "C" {
|
||||
|| defined(__s390x__) /* S390 64-bit */ \
|
||||
|| defined(__s390__) /* S390 32-bit */ \
|
||||
|| defined(__ARMEB__) /* ARM big endian */ \
|
||||
|| defined(__AARCH64EB__) /* ARM64 big endian */ \
|
||||
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
|
||||
&& defined(__BIG_ENDIAN))
|
||||
#define JANET_BIG_ENDIAN 1
|
||||
|
||||
@@ -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 (describe e) x) (eflush)))
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (string e) x) (eflush)))
|
||||
x)
|
||||
|
||||
(defn skip-asserts
|
||||
@@ -50,11 +50,6 @@
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defmacro assert-error-value
|
||||
[msg errval & forms]
|
||||
(def e (gensym))
|
||||
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
|
||||
|
||||
(defn check-compile-error
|
||||
[form]
|
||||
(def result (compile form))
|
||||
|
||||
@@ -990,6 +990,17 @@
|
||||
(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))))
|
||||
|
||||
@@ -1023,11 +1034,4 @@
|
||||
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
|
||||
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
|
||||
|
||||
# different try overloads
|
||||
(assert (= (try (error :error) ([] :caught)) :caught))
|
||||
(assert (= (try (error :error) ([e] e)) :error))
|
||||
(assert (= (try (error :error) ([e fib] [e (fiber? fib)])) [:error true]))
|
||||
# regression test for #1659
|
||||
(assert (= (try (error :error) ([_ _] :caught)) :caught))
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -117,17 +117,8 @@
|
||||
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
|
||||
(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
|
||||
|
||||
# Try installing a bundle that is missing bundle script
|
||||
(assert-error-value "bundle missing bundle script"
|
||||
"bundle must contain bundle.janet or bundle/init.janet"
|
||||
(bundle/install "./examples/sample-bad-bundle1"))
|
||||
(assert (= 0 (length (bundle/list))) "check failure 0")
|
||||
(assert (= 0 (length (bundle/topolist))) "check failure 1")
|
||||
|
||||
# Try installing a bundle that fails check
|
||||
(assert-error-value "bundle check hook fails"
|
||||
"Check failed!"
|
||||
(bundle/install "./examples/sample-bad-bundle2" :check true))
|
||||
(assert-error "bad test" (bundle/install "./examples/sample-bad-bundle" :check true))
|
||||
(assert (= 0 (length (bundle/list))) "check failure 0")
|
||||
(assert (= 0 (length (bundle/topolist))) "check failure 1")
|
||||
|
||||
|
||||
50
test/suite-sysir.janet
Normal file
50
test/suite-sysir.janet
Normal file
@@ -0,0 +1,50 @@
|
||||
# Copyright (c) 2025 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(use ../examples/sysir/frontend)
|
||||
(assert true) # smoke test
|
||||
|
||||
(def janet (dyn *executable*))
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
(defn do-expect-directory
|
||||
"Iterate a directory, evaluating all scripts in the directory. Assert that the captured output of the script
|
||||
is as expected according to a matching .expect file."
|
||||
[dir]
|
||||
(each path (sorted (os/dir dir))
|
||||
(when (string/has-suffix? ".janet" path)
|
||||
(def fullpath (string dir "/" path))
|
||||
(def proc (os/spawn [;run janet fullpath] :p {:out :pipe :err :out}))
|
||||
(def buff @"")
|
||||
(var ret-code nil)
|
||||
(ev/gather
|
||||
(while (ev/read (proc :out) 4096 buff))
|
||||
(set ret-code (os/proc-wait proc)))
|
||||
(def expect-file (string dir "/" path ".expect"))
|
||||
(def expected-out (slurp expect-file))
|
||||
(assert (= (string/trim expected-out) (string/trim buff))
|
||||
(string "\nfile: " fullpath "\nexpected:\n======\n" expected-out "\n======\ngot:\n======\n" buff "\n======\n")))))
|
||||
|
||||
(do-expect-directory "test/sysir")
|
||||
|
||||
(end-suite)
|
||||
28
test/sysir/arrays1.janet
Normal file
28
test/sysir/arrays1.janet
Normal file
@@ -0,0 +1,28 @@
|
||||
(def types-asm
|
||||
'((type-prim Double f64)
|
||||
(type-array BigVec Double 100)))
|
||||
|
||||
(def add-asm
|
||||
'((link-name "add_vector")
|
||||
(parameter-count 2)
|
||||
# Declarations
|
||||
(bind a BigVec)
|
||||
(bind b BigVec)
|
||||
(bind c BigVec)
|
||||
(add c a b)
|
||||
(return c)))
|
||||
|
||||
(def sub-asm
|
||||
'((link-name "sub_vector")
|
||||
(parameter-count 2)
|
||||
(bind a BigVec)
|
||||
(bind b BigVec)
|
||||
(bind c BigVec)
|
||||
(subtract c a b)
|
||||
(return c)))
|
||||
|
||||
(def ctx (sysir/context))
|
||||
(sysir/asm ctx types-asm)
|
||||
(sysir/asm ctx add-asm)
|
||||
(sysir/asm ctx sub-asm)
|
||||
(printf "%.99j" (sysir/to-ir ctx))
|
||||
1
test/sysir/arrays1.janet.expect
Normal file
1
test/sysir/arrays1.janet.expect
Normal file
@@ -0,0 +1 @@
|
||||
@[@[(type-prim Double f64) (type-array BigVec Double 100)] @[(parameter-count 0)] @[(link-name "add_vector") (parameter-count 2) (type-bind 0 BigVec) (type-bind 1 BigVec) (type-bind 2 BigVec) (add 2 0 1) (return 2)] @[(link-name "sub_vector") (parameter-count 2) (type-bind 0 BigVec) (type-bind 1 BigVec) (type-bind 2 BigVec) (subtract 2 0 1) (return 2)]]
|
||||
22
test/sysir/arrays2.janet
Normal file
22
test/sysir/arrays2.janet
Normal file
@@ -0,0 +1,22 @@
|
||||
(def ir-asm
|
||||
'((link-name "add_vectorp")
|
||||
(parameter-count 2)
|
||||
|
||||
# Types
|
||||
(type-prim Double f64)
|
||||
(type-array BigVec Double 100)
|
||||
(type-pointer BigVecP BigVec)
|
||||
|
||||
# Declarations
|
||||
(bind 0 BigVecP)
|
||||
(bind 1 BigVecP)
|
||||
(bind 2 BigVecP)
|
||||
(add 2 0 1)
|
||||
(return 2)))
|
||||
|
||||
(def ctx (sysir/context))
|
||||
(sysir/asm ctx ir-asm)
|
||||
(printf "%j" (sysir/to-ir ctx))
|
||||
(sysir/scalarize ctx)
|
||||
(printf "%j" (sysir/to-ir ctx))
|
||||
(print (sysir/to-c ctx))
|
||||
66
test/sysir/arrays2.janet.expect
Normal file
66
test/sysir/arrays2.janet.expect
Normal file
@@ -0,0 +1,66 @@
|
||||
@[@[(type-prim Double f64) (type-array BigVec Double 100) (type-pointer BigVecP BigVec)] @[(link-name "add_vectorp") (parameter-count 2) (type-bind 0 BigVecP) (type-bind 1 BigVecP) (type-bind 2 BigVecP) (add 2 0 1) (return 2)]]
|
||||
@[@[(type-prim Double f64) (type-array BigVec Double 100) (type-pointer BigVecP BigVec)] @[(link-name "add_vectorp") (parameter-count 2) (type-bind 0 BigVecP) (type-bind 1 BigVecP) (type-bind 2 BigVecP) (type-bind 3 U32Index) (type-bind 5 PointerTo) (type-bind 6 PointerTo) (type-bind 7 PointerTo) (type-bind 4 Boolean) (load 3 [U32Index 0]) (label 7) (gte 4 3 [U32Index 0]) (branch 4 21) (apgetp 5 0 3) (apgetp 6 1 3) (apgetp 7 2 3) (add 7 5 6) (add 3 3 [U32Index 1]) (jump 7) (label 21) (return 2)]]
|
||||
#include <stddef.h>
|
||||
#include <unistd.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <sys/syscall.h>
|
||||
#define _t0 void
|
||||
|
||||
#line 6
|
||||
typedef double _t1;
|
||||
#line 7
|
||||
typedef struct { _t1 els[100]; } _t2;
|
||||
#line 8
|
||||
typedef _t2 *_t3;
|
||||
|
||||
|
||||
_t3 add_vectorp(_t3 _r0, _t3 _r1)
|
||||
{
|
||||
_t3 _r2;
|
||||
_t4 _r3;
|
||||
_t5 _r4;
|
||||
_t6 _r5;
|
||||
_t6 _r6;
|
||||
_t6 _r7;
|
||||
|
||||
#line 6
|
||||
#line 7
|
||||
#line 8
|
||||
#line 11
|
||||
#line 12
|
||||
#line 13
|
||||
#line 14
|
||||
#line 14
|
||||
#line 14
|
||||
#line 14
|
||||
#line 14
|
||||
#line 14
|
||||
_r3 = *(0);
|
||||
#line 14
|
||||
|
||||
_label_0:
|
||||
#line 14
|
||||
_r4 = _r3 > 0;
|
||||
#line 14
|
||||
if (_r4) goto _label_1;
|
||||
#line 14
|
||||
_r5 = &(_r0->els[_r3]);
|
||||
#line 14
|
||||
_r6 = &(_r1->els[_r3]);
|
||||
#line 14
|
||||
_r7 = &(_r2->els[_r3]);
|
||||
#line 14
|
||||
_r7 = _r5 + _r6;
|
||||
#line 14
|
||||
_r3 = _r3 + 1;
|
||||
#line 14
|
||||
goto _label_0;
|
||||
#line 14
|
||||
|
||||
_label_1:
|
||||
#line 15
|
||||
return _r2;
|
||||
}
|
||||
35
test/sysir/basic1.janet
Normal file
35
test/sysir/basic1.janet
Normal file
@@ -0,0 +1,35 @@
|
||||
(def ir-asm
|
||||
'((link-name "test_function")
|
||||
|
||||
# Types
|
||||
(type-prim Int s32)
|
||||
(type-prim Double f64)
|
||||
(type-struct MyPair 0 1)
|
||||
(type-pointer PInt Int)
|
||||
(type-array DoubleArray 1 1024)
|
||||
|
||||
# Declarations
|
||||
(bind 0 Int)
|
||||
(bind 1 Int)
|
||||
(bind 2 Int)
|
||||
(bind 3 Double)
|
||||
(bind bob Double)
|
||||
(bind 5 Double)
|
||||
(bind 6 MyPair)
|
||||
|
||||
# Code
|
||||
(move 0 (Int 10))
|
||||
(move 0 (Int 21))
|
||||
:location
|
||||
(add 2 1 0)
|
||||
(move 3 (Double 1.77))
|
||||
(call :default 3 (PInt sin) 3)
|
||||
(cast bob 2)
|
||||
(call :default bob (PInt test_function))
|
||||
(add 5 bob 3)
|
||||
(jump :location)
|
||||
(return 5)))
|
||||
|
||||
(def ctx (sysir/context))
|
||||
(sysir/asm ctx ir-asm)
|
||||
(print (sysir/to-c ctx))
|
||||
71
test/sysir/basic1.janet.expect
Normal file
71
test/sysir/basic1.janet.expect
Normal file
@@ -0,0 +1,71 @@
|
||||
#include <stddef.h>
|
||||
#include <unistd.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <sys/syscall.h>
|
||||
#define _t0 void
|
||||
|
||||
#line 5
|
||||
typedef int32_t _t1;
|
||||
#line 6
|
||||
typedef double _t2;
|
||||
#line 7
|
||||
typedef struct {
|
||||
_t0 _f0;
|
||||
_t1 _f1;
|
||||
} _t3;
|
||||
#line 8
|
||||
typedef _t1 *_t4;
|
||||
#line 9
|
||||
typedef struct { _t1 els[1024]; } _t5;
|
||||
|
||||
|
||||
_t2 test_function()
|
||||
{
|
||||
_t1 _r0;
|
||||
_t1 _r1;
|
||||
_t1 _r2;
|
||||
_t2 _r3;
|
||||
_t2 _r4;
|
||||
_t2 _r5;
|
||||
_t3 _r6;
|
||||
|
||||
#line 5
|
||||
#line 6
|
||||
#line 7
|
||||
#line 7
|
||||
#line 8
|
||||
#line 9
|
||||
#line 12
|
||||
#line 13
|
||||
#line 14
|
||||
#line 15
|
||||
#line 16
|
||||
#line 17
|
||||
#line 18
|
||||
#line 21
|
||||
_r0 = 10;
|
||||
#line 22
|
||||
_r0 = 21;
|
||||
|
||||
_label_0:
|
||||
#line 24
|
||||
_r2 = _r1 + _r0;
|
||||
#line 25
|
||||
_r3 = 1.77;
|
||||
#line 26
|
||||
_r3 = sin(_r3);
|
||||
#line 26
|
||||
#line 27
|
||||
_r4 = (_t2) _r2;
|
||||
#line 28
|
||||
_r4 = test_function();
|
||||
#line 29
|
||||
_r5 = _r4 + _r3;
|
||||
#line 30
|
||||
goto _label_0;
|
||||
#line 31
|
||||
return _r5;
|
||||
}
|
||||
62
test/sysir/basic2.janet
Normal file
62
test/sysir/basic2.janet
Normal file
@@ -0,0 +1,62 @@
|
||||
### typedef struct {float x; float y; float z;} Vec3;
|
||||
###
|
||||
### Vec3 addv(Vec3 a, Vec3 b) {
|
||||
### Vec3 ret;
|
||||
### ret.x = a.x + b.x;
|
||||
### ret.y = a.y + b.y;
|
||||
### ret.z = a.z + b.z;
|
||||
### return ret;
|
||||
### }
|
||||
|
||||
# Use fgetp for code gen
|
||||
|
||||
(def ir-asm
|
||||
'((link-name "addv")
|
||||
(parameter-count 2)
|
||||
|
||||
# Types
|
||||
(type-prim Real f32)
|
||||
(type-struct Vec3 Real Real Real)
|
||||
(type-pointer PReal Real)
|
||||
|
||||
# Declarations
|
||||
(bind position Vec3)
|
||||
(bind velocity Vec3)
|
||||
(bind next-position Vec3)
|
||||
(bind dest Real)
|
||||
(bind lhs Real)
|
||||
(bind rhs Real)
|
||||
(bind pdest PReal)
|
||||
(bind plhs PReal)
|
||||
(bind prhs PReal)
|
||||
|
||||
# Code
|
||||
(fgetp pdest next-position 0)
|
||||
(fgetp plhs position 0)
|
||||
(fgetp prhs velocity 0)
|
||||
(load lhs plhs)
|
||||
(load rhs prhs)
|
||||
(add dest lhs rhs)
|
||||
(store pdest dest)
|
||||
|
||||
(fgetp pdest next-position 1)
|
||||
(fgetp plhs position 1)
|
||||
(fgetp prhs velocity 1)
|
||||
(load lhs plhs)
|
||||
(load rhs prhs)
|
||||
(add dest lhs rhs)
|
||||
(store pdest dest)
|
||||
|
||||
(fgetp pdest next-position 2)
|
||||
(fgetp plhs position 2)
|
||||
(fgetp prhs velocity 2)
|
||||
(load lhs plhs)
|
||||
(load rhs prhs)
|
||||
(add dest lhs rhs)
|
||||
(store pdest dest)
|
||||
|
||||
(return next-position)))
|
||||
|
||||
(def ctx (sysir/context))
|
||||
(sysir/asm ctx ir-asm)
|
||||
(print (sysir/to-c ctx))
|
||||
1
test/sysir/basic2.janet.expect
Normal file
1
test/sysir/basic2.janet.expect
Normal file
@@ -0,0 +1 @@
|
||||
nope
|
||||
1
test/sysir/smoke.janet
Normal file
1
test/sysir/smoke.janet
Normal file
@@ -0,0 +1 @@
|
||||
(print "hello")
|
||||
1
test/sysir/smoke.janet.expect
Normal file
1
test/sysir/smoke.janet.expect
Normal file
@@ -0,0 +1 @@
|
||||
hello
|
||||
21
tools/x64.sh
Executable file
21
tools/x64.sh
Executable file
@@ -0,0 +1,21 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
case "$2" in
|
||||
c)
|
||||
rm temp.bin temp.o temp.nasm
|
||||
build/janet "$@" > temp.c
|
||||
gcc -nostdlib temp.c -c temp.o
|
||||
;;
|
||||
x64)
|
||||
rm temp.bin temp.o temp.nasm
|
||||
build/janet "$@" > temp.nasm
|
||||
nasm -felf64 temp.nasm -l temp.lst -o temp.o
|
||||
;;
|
||||
*)
|
||||
echo "Unknown mode $2"
|
||||
exit
|
||||
;;
|
||||
esac
|
||||
|
||||
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
|
||||
./temp.bin
|
||||
Reference in New Issue
Block a user