mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-24 23:40:27 +00:00
Code Issues 1 Releases Wiki Activity

Rename to janet

Browse Source
This commit is contained in:
Calvin Rose 2018-09-05 22:18:42 -04:00
parent 285f2d7ea9
commit c8ef2a0d88
69 changed files with 6199 additions and 6259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,6 +1,8 @@
# Target
dst
!*/**/dst
janet
!*/**/janet
/build
/Build
/Release

94
Makefile
View File

@ -24,7 +24,7 @@
PREFIX?=/usr
INCLUDEDIR=$(PREFIX)/include/dst
INCLUDEDIR=$(PREFIX)/include/janet
LIBDIR=$(PREFIX)/lib
BINDIR=$(PREFIX)/bin
@ -36,8 +36,8 @@ BINDIR=$(PREFIX)/bin
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden
CLIBS=-lm -ldl
PREFIX=/usr/local
DST_TARGET=dst
DST_LIBRARY=libdst.so
JANET_TARGET=janet
JANET_LIBRARY=libjanet.so
DEBUGGER=gdb
UNAME:=$(shell uname -s)
@ -50,17 +50,17 @@ else
endif
# Source headers
DST_GENERATED_HEADERS= \
JANET_GENERATED_HEADERS= \
src/include/generated/core.h \
src/include/generated/init.h
DST_HEADERS=$(sort $(wildcard src/include/dst/*.h))
DST_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
JANET_HEADERS=$(sort $(wildcard src/include/janet/*.h))
JANET_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
# Source files
DST_CORE_SOURCES=$(sort $(wildcard src/core/*.c))
DST_MAINCLIENT_SOURCES=$(sort $(wildcard src/mainclient/*.c))
JANET_CORE_SOURCES=$(sort $(wildcard src/core/*.c))
JANET_MAINCLIENT_SOURCES=$(sort $(wildcard src/mainclient/*.c))
all: $(DST_TARGET) $(DST_LIBRARY)
all: $(JANET_TARGET) $(JANET_LIBRARY)
###################################
##### The code generator tool #####
@ -73,11 +73,11 @@ xxd: src/tools/xxd.c
##### Generated Headers #####
#############################
src/include/generated/init.h: src/mainclient/init.dst xxd
./xxd $< $@ dst_gen_init
src/include/generated/init.h: src/mainclient/init.janet xxd
./xxd $< $@ janet_gen_init
src/include/generated/core.h: src/core/core.dst xxd
./xxd $< $@ dst_gen_core
src/include/generated/core.h: src/core/core.janet xxd
./xxd $< $@ janet_gen_core
# Only a few files depend on the generated headers
src/core/corelib.o: src/include/generated/core.h
@ -87,49 +87,49 @@ src/mainclient/main.o: src/include/generated/init.h
##### The main interpreter program and shared object #####
##########################################################
DST_ALL_SOURCES=$(DST_CORE_SOURCES) \
$(DST_MAINCLIENT_SOURCES)
JANET_ALL_SOURCES=$(JANET_CORE_SOURCES) \
$(JANET_MAINCLIENT_SOURCES)
DST_CORE_OBJECTS=$(patsubst %.c,%.o,$(DST_CORE_SOURCES))
DST_ALL_OBJECTS=$(patsubst %.c,%.o,$(DST_ALL_SOURCES))
JANET_CORE_OBJECTS=$(patsubst %.c,%.o,$(JANET_CORE_SOURCES))
JANET_ALL_OBJECTS=$(patsubst %.c,%.o,$(JANET_ALL_SOURCES))
%.o: %.c $(DST_HEADERS) $(DST_LOCAL_HEADERS)
%.o: %.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
$(CC) $(CFLAGS) -o $@ -c $<
$(DST_TARGET): $(DST_ALL_OBJECTS)
$(CC) $(CFLAGS) -o $(DST_TARGET) $^ $(CLIBS)
$(JANET_TARGET): $(JANET_ALL_OBJECTS)
$(CC) $(CFLAGS) -o $(JANET_TARGET) $^ $(CLIBS)
$(DST_LIBRARY): $(DST_CORE_OBJECTS)
$(CC) $(CFLAGS) -shared -o $(DST_LIBRARY) $^ $(CLIBS)
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
$(CC) $(CFLAGS) -shared -o $(JANET_LIBRARY) $^ $(CLIBS)
###################
##### Testing #####
###################
repl: $(DST_TARGET)
./$(DST_TARGET)
repl: $(JANET_TARGET)
./$(JANET_TARGET)
debug: $(DST_TARGET)
$(DEBUGGER) ./$(DST_TARGET)
debug: $(JANET_TARGET)
$(DEBUGGER) ./$(JANET_TARGET)
valgrind: $(DST_TARGET)
valgrind --leak-check=full -v ./$(DST_TARGET)
valgrind: $(JANET_TARGET)
valgrind --leak-check=full -v ./$(JANET_TARGET)
test: $(DST_TARGET)
./$(DST_TARGET) test/suite0.dst
./$(DST_TARGET) test/suite1.dst
./$(DST_TARGET) test/suite2.dst
test: $(JANET_TARGET)
./$(JANET_TARGET) test/suite0.janet
./$(JANET_TARGET) test/suite1.janet
./$(JANET_TARGET) test/suite2.janet
valtest: $(DST_TARGET)
valgrind --leak-check=full -v ./$(DST_TARGET) test/suite0.dst
valgrind --leak-check=full -v ./$(DST_TARGET) test/suite1.dst
valgrind --leak-check=full -v ./$(DST_TARGET) test/suite2.dst
valtest: $(JANET_TARGET)
valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite0.janet
valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite1.janet
valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite2.janet
###################
##### Natives #####
###################
natives: $(DST_TARGET)
natives: $(JANET_TARGET)
$(MAKE) -C natives/json
$(MAKE) -j 8 -C natives/sqlite3
@ -142,25 +142,25 @@ clean-natives:
#################
clean:
-rm $(DST_TARGET)
-rm $(JANET_TARGET)
-rm src/**/*.o
-rm vgcore.*
-rm $(DST_GENERATED_HEADERS)
-rm $(JANET_GENERATED_HEADERS)
install: $(DST_TARGET)
cp $(DST_TARGET) $(BINDIR)/$(DST_TARGET)
install: $(JANET_TARGET)
cp $(JANET_TARGET) $(BINDIR)/$(JANET_TARGET)
mkdir -p $(INCLUDEDIR)
cp $(DST_HEADERS) $(INCLUDEDIR)
cp $(DST_LIBRARY) $(LIBDIR)/$(DST_LIBRARY)
cp $(JANET_HEADERS) $(INCLUDEDIR)
cp $(JANET_LIBRARY) $(LIBDIR)/$(JANET_LIBRARY)
$(LDCONFIG)
install-libs: natives
cp lib/* $(DST_PATH)
cp natives/*/*.so $(DST_PATH)
cp lib/* $(JANET_PATH)
cp natives/*/*.so $(JANET_PATH)
uninstall:
-rm $(BINDIR)/$(DST_TARGET)
-rm $(LIBDIR)/$(DST_LIBRARY)
-rm $(BINDIR)/$(JANET_TARGET)
-rm $(LIBDIR)/$(JANET_LIBRARY)
-rm -rf $(INCLUDEDIR)
$(LDCONFIG)

71
README.md
View File

@ -1,31 +1,35 @@
# dst
# janet
[![Build Status](https://travis-ci.org/bakpakin/dst.svg?branch=master)](https://travis-ci.org/bakpakin/dst)
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/32r7s2skrgm9ubva?svg=true)](https://ci.appveyor.com/project/bakpakin/dst)
[![Build Status](https://travis-ci.org/bakpakin/janet.svg?branch=master)](https://travis-ci.org/bakpakin/janet)
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/32r7s2skrgm9ubva?svg=true)](https://ci.appveyor.com/project/bakpakin/janet)
Dst is a functional and imperative programming language and bytecode interpreter. It is a
Janet is a functional and imperative programming language and bytecode interpreter. It is a
modern lisp, but lists are replaced
by other data structures with better utility and performance (arrays, tables, structs, tuples).
The language can also easily bridge to native code written in C, and supports abstract datatypes
for interfacing with C. Also support meta programming with macros, and bytecode assembly for the
dst abstract machine. The bytecode vm is a register based vm loosely inspired by the LuaJIT
janet abstract machine. The bytecode vm is a register based vm loosely inspired by the LuaJIT
bytecode format, but simpler and safer (bytecode can be verified by the assembler).
There is a repl for trying out the language, as well as the ability
to run script files. This client program is separate from the core runtime, so
dst could be embedded into other programs.
janet could be embedded into other programs.
Implemented in mostly standard C99, dst runs on Windows, Linux and macOS.
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
The few features that are not standard C (dynamic library loading, compiler specific optimizations),
are fairly straight forward. Dst can be easily ported to new platforms.
are fairly straight forward. Janet can be easily ported to new platforms.
There is not much in the way of documentation yet because it is still a "personal project" and
I don't want to freeze features prematurely. You can look in the examples directory, the test directory,
or the file `src/core/core.dst` to get a sense of what dst code looks like.
or the file `src/core/core.janet` to get a sense of what janet code looks like.
For syntax highlighting, there is some preliminary vim syntax highlighting in [dst.vim](https://github.com/bakpakin/dst.vim).
For syntax highlighting, there is some preliminary vim syntax highlighting in [janet.vim](https://github.com/bakpakin/janet.vim).
Generic lisp syntax highlighting should, however, provide good results.
## Use Cases
Janet makes a good system scripting language, or a language to embed in other programs. Think Lua or Guile.
## Features
* First class closures
@ -44,37 +48,36 @@ Generic lisp syntax highlighting should, however, provide good results.
* Imperative programming as well as functional
* REPL
* Interactive environment with detailed stack traces
* SQLite bindings
## Documentation
API documentation and design documents can be found in the
[wiki](https://github.com/bakpakin/dst/wiki). Not at all complete.
[wiki](https://github.com/bakpakin/janet/wiki). Not at all complete.
## Usage
A repl is launched when the binary is invoked with no arguments. Pass the -h flag
to display the usage information. Individual scripts can be run with `./dst myscript.dst`
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
If you are looking to explore, you can print a list of all available macros, functions, and constants
by entering the command `(all-symbols)` into the repl.
```
$ ./dst
Dst 0.0.0 alpha Copyright (C) 2017-2018 Calvin Rose
dst:1:> (+ 1 2 3)
$ ./janet
Janet 0.0.0 alpha Copyright (C) 2017-2018 Calvin Rose
janet:1:> (+ 1 2 3)
6
dst:2:> (print "Hello, World!")
janet:2:> (print "Hello, World!")
Hello, World!
nil
dst:3:> (os.exit)
$ ./dst -h
usage: ./dst [options] scripts...
janet:3:> (os.exit)
$ ./janet -h
usage: ./janet [options] scripts...
Options are:
-h Show this help
-v Print the version string
-s Use raw stdin instead of getline like functionality
-e Execute a string of dst
-e Execute a string of janet
-r Enter the repl after running all scripts
-p Keep on executing if there is a top level error (persistent)
-- Stop handling option
@ -83,16 +86,16 @@ $
## Compiling and Running
Dst only uses Make and batch files to compile on Posix and windows
respectively. To configure dst, edit the header file src/include/dst/dst.h
Janet only uses Make and batch files to compile on Posix and windows
respectively. To configure janet, edit the header file src/include/janet/janet.h
before compilation.
### Posix
On most platforms, use Make to build dst. To
On most platforms, use Make to build janet. To
```sh
cd somewhere/my/projects/dst
cd somewhere/my/projects/janet
make
make test
```
@ -101,13 +104,13 @@ make test
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#)
or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with dst.
3. Run `build_win` to compile dst.
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
3. Run `build_win` to compile janet.
4. Run `build_win test` to make sure everything is working.
## Examples
See the examples directory for some example dst code.
See the examples directory for some example janet code.
## SQLite bindings
@ -121,21 +124,21 @@ make natives
Next, enter the repl and create a database and a table.
```
dst:1:> (import natives.sqlite3 :as sql)
janet:1:> (import natives.sqlite3 :as sql)
nil
dst:2:> (def db (sql.open "test.db"))
janet:2:> (def db (sql.open "test.db"))
<sqlite3.connection 0x5561A138C470>
dst:3:> (sql.eval db `CREATE TABLE customers(id INTEGER PRIMARY KEY, name TEXT);`)
janet:3:> (sql.eval db `CREATE TABLE customers(id INTEGER PRIMARY KEY, name TEXT);`)
@[]
dst:4:> (sql.eval db `INSERT INTO customers VALUES(:id, :name);` {:name "John" :id 12345})
janet:4:> (sql.eval db `INSERT INTO customers VALUES(:id, :name);` {:name "John" :id 12345})
@[]
dst:5:> (sql.eval db `SELECT * FROM customers;`)
janet:5:> (sql.eval db `SELECT * FROM customers;`)
@[{"id" 12345 "name" "John"}]
```
Finally, close the database connection when done with it.
```
dst:6:> (sql.close db)
janet:6:> (sql.close db)
nil
```

2
appveyor.yml
View File

@ -3,7 +3,7 @@ branches:
only:
- master
- alpha
clone_folder: c:\projects\dst
clone_folder: c:\projects\janet
image:
- Visual Studio 2017
configuration:

28
build_win.bat
View File

@ -1,6 +1,6 @@
@rem Build dst on windows
@rem Build janet on windows
@rem
@rem Open a "Windows SDK Command Shell" and cd to the dst directory
@rem Open a "Windows SDK Command Shell" and cd to the janet directory
@rem Then run this script with no arguments to build the executable
@echo off
@ -15,8 +15,8 @@
@rem Set compile and link options here
@setlocal
@set DST_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
@set DST_LINK=link /nologo
@set JANET_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
@set JANET_LINK=link /nologo
mkdir build
mkdir build\core
@ -29,28 +29,28 @@ mkdir build\mainclient
@if errorlevel 1 goto :BUILDFAIL
@rem Generate the headers
@build\xxd.exe src\core\core.dst src\include\generated\core.h dst_gen_core
@build\xxd.exe src\core\core.janet src\include\generated\core.h janet_gen_core
@if errorlevel 1 goto :BUILDFAIL
@build\xxd.exe src\mainclient\init.dst src\include\generated\init.h dst_gen_init
@build\xxd.exe src\mainclient\init.janet src\include\generated\init.h janet_gen_init
@if errorlevel 1 goto :BUILDFAIL
@rem Build the sources
for %%f in (src\core\*.c) do (
@%DST_COMPILE% /Fobuild\core\%%~nf.obj %%f
@%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
@if errorlevel 1 goto :BUILDFAIL
)
@rem Build the main client
for %%f in (src\mainclient\*.c) do (
@%DST_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
@%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
@if errorlevel 1 goto :BUILDFAIL
)
@rem Link everything to main client
%DST_LINK% /out:dst.exe build\core\*.obj build\mainclient\*.obj
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj
@if errorlevel 1 goto :BUILDFAIL
echo === Successfully built dst.exe for Windows ===
echo === Successfully built janet.exe for Windows ===
echo === Run 'build_win test' to run tests. ==
echo === Run 'build_win clean' to delete build artifacts. ===
exit /b 0
@ -65,20 +65,20 @@ exit /b 1
@echo.
@echo Usage: build_windows [subcommand=clean,help,test]
@echo.
@echo Script to build dst on windows. Must be run from the Visual Studio
@echo Script to build janet on windows. Must be run from the Visual Studio
@echo command prompt.
exit /b 0
@rem Clean build artifacts
:CLEAN
del dst.exe dst.exp dst.lib
del janet.exe janet.exp janet.lib
rd /s /q build
exit /b 0
@rem Run tests
:TEST
for %%f in (test/suite*.dst) do (
dst.exe test\%%f
for %%f in (test/suite*.janet) do (
janet.exe test\%%f
@if errorlevel 1 goto :TESTFAIL
)
exit /b 0

0
examples/3sum.dst → examples/3sum.janet
View File

0
examples/assembly.dst → examples/assembly.janet
View File

2
examples/error.dst → examples/error.janet
View File

@ -1,4 +1,4 @@
# An example file that errors out. Run with ./dst examples/error.dst
# An example file that errors out. Run with ./janet examples/error.janet
# to see stack trace for runtime errors.
(defn bork [x]

0
examples/fizzbuzz.dst → examples/fizzbuzz.janet
View File

0
examples/hello.dst → examples/hello.janet
View File

0
examples/iterators.dst → examples/iterators.janet
View File

0
examples/maxtriangle.dst → examples/maxtriangle.janet
View File

0
examples/primes.dst → examples/primes.janet
View File

0
lib/colors.dst → lib/colors.janet
View File

107
lib/lazyseqs.dst
View File

@ -1,107 +0,0 @@
# An example implementation of functional, lazy
# sequences, as in clojure. The lazy seq is essentially
# A lazy linked list, where the next value is a function
# that must be called (realizing it), and the memoized.
# Use with (import "./path/to/this/file" :prefix "seq.")
(defmacro delay [& forms]
"Lazily evaluate a series of expressions. Returns a function that
returns the result of the last expression. Will only evaluate the
body once, and then memoizes the result."
(def $state (gensym))
(def $loaded (gensym))
(tuple 'do
(tuple 'var $state nil)
(tuple 'var $loaded nil)
(tuple 'fn []
(tuple 'if $loaded
$state
(tuple 'do
(tuple ':= $loaded true)
(tuple ':= $state (tuple.prepend forms 'do)))))))
# Use tuples instead of structs to save memory
(def HEAD :private 0)
(def TAIL :private 1)
(defn empty-seq
"The empty sequence."
[] nil)
(defmacro cons
"Create a new sequence by prepending a value to the original sequence."
[h t]
(def x (tuple h t))
(fn [] x))
(defn empty?
"Check if a sequence is empty."
[s]
(not (s)))
(defn head
"Get the next value of the sequence."
[s]
(get (s) HEAD))
(defn tail
"Get the rest of a sequence"
[s]
(get (s) TAIL))
(defn range2
"Return a sequence of integers [start, end)."
[start end]
(if (< start end)
(delay (tuple start (range2 (+ 1 start) end)))
empty-seq))
(defn range
"Return a sequence of integers [0, end)."
[end]
(range2 0 end))
(defn map
"Return a sequence that is the result of applying f to each value in s."
[f s]
(delay
(def x (s))
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
(defn realize
"Force evaluation of a lazy sequence."
[s]
(when (s) (realize (tail s))))
(defn realize-map [f s]
"Evaluate f on each member of the sequence. Forces evaluation."
(when (s) (f (head s)) (realize-map f (tail s))))
(defn drop
"Ignores the first n values of the sequence and returns the rest."
[n s]
(delay
(def x (s))
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
(defn take
"Returns at most the first n values of s."
[n s]
(delay
(def x (s))
(if (and x (pos? n))
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
(defn randseq
"Return a sequence of random numbers."
[]
(delay (tuple (random) (randseq))))
(defn take-while
"Returns a sequence of values until the predicate is false."
[pred s]
(delay
(def x (s))
(when x
(def thehead (get HEAD x))
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))

41
lib/lazyseqs.janet Normal file
View File

@ -0,0 +1,41 @@
# Ansi terminal colors
(def- colormap
{:black 30
:bg-black 40
:red 31
:bg-red 41
:green 32
:bg-green 42
:yellow 33
:bg-yellow 43
:blue 34
:bg-blue 44
:magenta 35
:bg-magenta 45
:cyan 36
:bg-cyan 46
:white 37
:bg-white 47
:bright-black 90
:bg-bright-black 100
:bright-red 91
:bg-bright-red 101
:bright-green 92
:bg-bright-green 102
:bright-yellow 93
:bg-bright-yellow 103
:bright-blue 94
:bg-bright-blue 104
:bright-magenta 95
:bg-bright-magenta 105
:bright-cyan 96
:bg-bright-cyan 106
:bright-white 97
:bg-bright-white 107})
(loop [[name color] :in (pairs colormap)]
(defglobal (string.slice name 1)
(fn color-wrapper [& pieces]
(string "\e[" color "m" (apply1 string pieces) "\e[0m"))))

2
natives/json/build_win.bat
View File

@ -7,7 +7,7 @@
cl /nologo /I..\..\src\include /c /O2 /W3 json.c
@if errorlevel 1 goto :BUILDFAIL
link /nologo /dll ..\..\dst.lib /out:json.dll *.obj
link /nologo /dll ..\..\janet.lib /out:json.dll *.obj
if errorlevel 1 goto :BUILDFAIL
@echo .

190
natives/json/json.c
View File

@ -20,7 +20,7 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include <stdlib.h>
#include <errno.h>
@ -71,8 +71,8 @@ static char *decode_utf16_escape(const char *p, uint32_t *outpoint) {
}
/* Parse a string */
const char *decode_string(const char **p, Dst *out) {
DstBuffer *buffer = dst_buffer(0);
const char *decode_string(const char **p, Janet *out) {
JanetBuffer *buffer = janet_buffer(0);
const char *cp = *p;
while (*cp != '"') {
uint8_t b = (uint8_t) *cp;
@ -127,36 +127,36 @@ const char *decode_string(const char **p, Dst *out) {
}
/* Write codepoint */
if (codepoint <= 0x7F) {
dst_buffer_push_u8(buffer, codepoint);
janet_buffer_push_u8(buffer, codepoint);
} else if (codepoint <= 0x7FF) {
dst_buffer_push_u8(buffer, ((codepoint >> 6) & 0x1F) | 0xC0);
dst_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x1F) | 0xC0);
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
} else if (codepoint <= 0xFFFF) {
dst_buffer_push_u8(buffer, ((codepoint >> 12) & 0x0F) | 0xE0);
dst_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
dst_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x0F) | 0xE0);
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
} else {
dst_buffer_push_u8(buffer, ((codepoint >> 18) & 0x07) | 0xF0);
dst_buffer_push_u8(buffer, ((codepoint >> 12) & 0x3F) | 0x80);
dst_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
dst_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
janet_buffer_push_u8(buffer, ((codepoint >> 18) & 0x07) | 0xF0);
janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x3F) | 0x80);
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
}
}
continue;
}
}
dst_buffer_push_u8(buffer, b);
janet_buffer_push_u8(buffer, b);
cp++;
}
*out = dst_stringv(buffer->data, buffer->count);
*out = janet_stringv(buffer->data, buffer->count);
*p = cp + 1;
return NULL;
}
static const char *decode_one(const char **p, Dst *out, int depth) {
static const char *decode_one(const char **p, Janet *out, int depth) {
/* Prevent stack overflow */
if (depth > DST_RECURSION_GUARD) goto recurdepth;
if (depth > JANET_RECURSION_GUARD) goto recurdepth;
/* Skip leading whitepspace */
skipwhite(p);
@ -176,7 +176,7 @@ static const char *decode_one(const char **p, Dst *out, int depth) {
double x = strtod(*p, &end);
if (end == *p) goto badnum;
*p = end;
*out = dst_wrap_real(x);
*out = janet_wrap_real(x);
break;
}
/* false, null, true */
@ -185,7 +185,7 @@ static const char *decode_one(const char **p, Dst *out, int depth) {
const char *cp = *p;
if (cp[1] != 'a' || cp[2] != 'l' || cp[3] != 's' || cp[4] != 'e')
goto badident;
*out = dst_wrap_false();
*out = janet_wrap_false();
*p = cp + 5;
break;
}
@ -195,7 +195,7 @@ static const char *decode_one(const char **p, Dst *out, int depth) {
if (cp[1] != 'u' || cp[2] != 'l' || cp[3] != 'l')
goto badident;
*out = dst_wrap_nil();
*out = janet_wrap_nil();
*p = cp + 4;
break;
}
@ -204,7 +204,7 @@ static const char *decode_one(const char **p, Dst *out, int depth) {
const char *cp = *p;
if (cp[1] != 'r' || cp[2] != 'u' || cp[3] != 'e')
goto badident;
*out = dst_wrap_true();
*out = janet_wrap_true();
*p = cp + 4;
break;
}
@ -225,37 +225,37 @@ static const char *decode_one(const char **p, Dst *out, int depth) {
}
if (*cp != '"') goto badchar;
*p = cp + 1;
*out = dst_stringv((const uint8_t *)start, cp - start);
*out = janet_stringv((const uint8_t *)start, cp - start);
break;
}
/* Array */
case '[':
{
*p = *p + 1;
DstArray *array = dst_array(0);
JanetArray *array = janet_array(0);
const char *err;
Dst subval;
Janet subval;
skipwhite(p);
while (**p != ']') {
err = decode_one(p, &subval, depth + 1);
if (err) return err;
dst_array_push(array, subval);
janet_array_push(array, subval);
skipwhite(p);
if (**p == ']') break;
if (**p != ',') goto wantcomma;
*p = *p + 1;
}
*p = *p + 1;
*out = dst_wrap_array(array);
*out = janet_wrap_array(array);
}
break;
/* Object */
case '{':
{
*p = *p + 1;
DstTable *table = dst_table(0);
JanetTable *table = janet_table(0);
const char *err;
Dst subkey, subval;
Janet subkey, subval;
skipwhite(p);
while (**p != '}') {
skipwhite(p);
@ -267,14 +267,14 @@ static const char *decode_one(const char **p, Dst *out, int depth) {
*p = *p + 1;
err = decode_one(p, &subval, depth + 1);
if (err) return err;
dst_table_put(table, subkey, subval);
janet_table_put(table, subkey, subval);
skipwhite(p);
if (**p == '}') break;
if (**p != ',') goto wantcomma;
*p = *p + 1;
}
*p = *p + 1;
*out = dst_wrap_table(table);
*out = janet_wrap_table(table);
break;
}
}
@ -301,23 +301,23 @@ wantstring:
return "expected json string";
}
static int json_decode(DstArgs args) {
Dst ret;
DST_FIXARITY(args, 1);
static int json_decode(JanetArgs args) {
Janet ret;
JANET_FIXARITY(args, 1);
const char *err;
const char *start;
const char *p;
if (dst_checktype(args.v[0], DST_BUFFER)) {
DstBuffer *buffer = dst_unwrap_buffer(args.v[0]);
if (janet_checktype(args.v[0], JANET_BUFFER)) {
JanetBuffer *buffer = janet_unwrap_buffer(args.v[0]);
/* Ensure 0 padded */
dst_buffer_push_u8(buffer, 0);
janet_buffer_push_u8(buffer, 0);
start = p = (const char *)buffer->data;
err = decode_one(&p, &ret, 0);
buffer->count--;
} else {
const uint8_t *bytes;
int32_t len;
DST_ARG_BYTES(bytes, len, args, 0);
JANET_ARG_BYTES(bytes, len, args, 0);
start = p = (const char *)bytes;
err = decode_one(&p, &ret, 0);
}
@ -328,12 +328,12 @@ static int json_decode(DstArgs args) {
err = "unexpected extra token";
}
if (err) {
DST_THROWV(args, dst_wrap_string(dst_formatc(
JANET_THROWV(args, janet_wrap_string(janet_formatc(
"decode error at postion %d: %s",
p - start,
err)));
}
DST_RETURN(args, ret);
JANET_RETURN(args, ret);
}
/*****************/
@ -341,7 +341,7 @@ static int json_decode(DstArgs args) {
/*****************/
typedef struct {
DstBuffer *buffer;
JanetBuffer *buffer;
int32_t indent;
const uint8_t *tab;
const uint8_t *newline;
@ -350,62 +350,62 @@ typedef struct {
} Encoder;
static const char *encode_newline(Encoder *e) {
if (dst_buffer_push_bytes(e->buffer, e->newline, e->newlinelen))
if (janet_buffer_push_bytes(e->buffer, e->newline, e->newlinelen))
return "buffer overflow";
for (int32_t i = 0; i < e->indent; i++)
if (dst_buffer_push_bytes(e->buffer, e->tab, e->tablen))
if (janet_buffer_push_bytes(e->buffer, e->tab, e->tablen))
return "buffer overflow";
return NULL;
}
static const char *encode_one(Encoder *e, Dst x, int depth) {
switch(dst_type(x)) {
static const char *encode_one(Encoder *e, Janet x, int depth) {
switch(janet_type(x)) {
default:
goto badtype;
case DST_NIL:
case JANET_NIL:
{
if (dst_buffer_push_cstring(e->buffer, "null"))
if (janet_buffer_push_cstring(e->buffer, "null"))
goto overflow;
}
break;
case DST_FALSE:
case JANET_FALSE:
{
if (dst_buffer_push_cstring(e->buffer, "false"))
if (janet_buffer_push_cstring(e->buffer, "false"))
goto overflow;
}
break;
case DST_TRUE:
case JANET_TRUE:
{
if (dst_buffer_push_cstring(e->buffer, "true"))
if (janet_buffer_push_cstring(e->buffer, "true"))
goto overflow;
}
break;
case DST_INTEGER:
case JANET_INTEGER:
{
char cbuf[20];
sprintf(cbuf, "%d", dst_unwrap_integer(x));
if (dst_buffer_push_cstring(e->buffer, cbuf))
sprintf(cbuf, "%d", janet_unwrap_integer(x));
if (janet_buffer_push_cstring(e->buffer, cbuf))
goto overflow;
}
break;
case DST_REAL:
case JANET_REAL:
{
char cbuf[25];
sprintf(cbuf, "%.17g", dst_unwrap_real(x));
if (dst_buffer_push_cstring(e->buffer, cbuf))
sprintf(cbuf, "%.17g", janet_unwrap_real(x));
if (janet_buffer_push_cstring(e->buffer, cbuf))
goto overflow;
}
break;
case DST_STRING:
case DST_SYMBOL:
case DST_BUFFER:
case JANET_STRING:
case JANET_SYMBOL:
case JANET_BUFFER:
{
const uint8_t *bytes;
const uint8_t *c;
const uint8_t *end;
int32_t len;
dst_bytes_view(x, &bytes, &len);
if (dst_buffer_push_u8(e->buffer, '"')) goto overflow;
janet_bytes_view(x, &bytes, &len);
if (janet_buffer_push_u8(e->buffer, '"')) goto overflow;
c = bytes;
end = bytes + len;
while (c < end) {
@ -445,9 +445,9 @@ static const char *encode_one(Encoder *e, Dst x, int depth) {
if (codepoint > 0x1F && codepoint < 0x80) {
/* Normal, no escape */
if (codepoint == '\\' || codepoint == '"')
if (dst_buffer_push_u8(e->buffer, '\\'))
if (janet_buffer_push_u8(e->buffer, '\\'))
goto overflow;
if (dst_buffer_push_u8(e->buffer, (uint8_t) codepoint))
if (janet_buffer_push_u8(e->buffer, (uint8_t) codepoint))
goto overflow;
} else if (codepoint < 0x10000) {
/* One unicode escape */
@ -458,7 +458,7 @@ static const char *encode_one(Encoder *e, Dst x, int depth) {
buf[3] = (codepoint >> 8) & 0xF;
buf[4] = (codepoint >> 4) & 0xF;
buf[5] = codepoint & 0xF;
if (dst_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
if (janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
goto overflow;
} else {
/* Two unicode escapes (surrogate pair) */
@ -478,28 +478,28 @@ static const char *encode_one(Encoder *e, Dst x, int depth) {
buf[9] = (lo >> 8) & 0xF;
buf[10] = (lo >> 4) & 0xF;
buf[11] = lo & 0xF;
if (dst_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
if (janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
goto overflow;
}
}
if (dst_buffer_push_u8(e->buffer, '"')) goto overflow;
if (janet_buffer_push_u8(e->buffer, '"')) goto overflow;
}
break;
case DST_TUPLE:
case DST_ARRAY:
case JANET_TUPLE:
case JANET_ARRAY:
{
const char *err;
const Dst *items;
const Janet *items;
int32_t len;
dst_indexed_view(x, &items, &len);
if (dst_buffer_push_u8(e->buffer, '[')) goto overflow;
janet_indexed_view(x, &items, &len);
if (janet_buffer_push_u8(e->buffer, '[')) goto overflow;
e->indent++;
if ((err = encode_newline(e))) return err;
for (int32_t i = 0; i < len; i++) {
if ((err = encode_newline(e))) return err;
if ((err = encode_one(e, items[i], depth + 1)))
return err;
if (dst_buffer_push_u8(e->buffer, ','))
if (janet_buffer_push_u8(e->buffer, ','))
goto overflow;
}
e->indent--;
@ -507,32 +507,32 @@ static const char *encode_one(Encoder *e, Dst x, int depth) {
e->buffer->count--;
if ((err = encode_newline(e))) return err;
}
if (dst_buffer_push_u8(e->buffer, ']')) goto overflow;
if (janet_buffer_push_u8(e->buffer, ']')) goto overflow;
}
break;
case DST_TABLE:
case DST_STRUCT:
case JANET_TABLE:
case JANET_STRUCT:
{
const char *err;
const DstKV *kvs;
const JanetKV *kvs;
int32_t count, capacity;
dst_dictionary_view(x, &kvs, &count, &capacity);
if (dst_buffer_push_u8(e->buffer, '{')) goto overflow;
janet_dictionary_view(x, &kvs, &count, &capacity);
if (janet_buffer_push_u8(e->buffer, '{')) goto overflow;
e->indent++;
for (int32_t i = 0; i < capacity; i++) {
if (dst_checktype(kvs[i].key, DST_NIL))
if (janet_checktype(kvs[i].key, JANET_NIL))
continue;
if (!dst_checktype(kvs[i].key, DST_STRING))
if (!janet_checktype(kvs[i].key, JANET_STRING))
return "only strings keys are allowed in objects";
if ((err = encode_newline(e))) return err;
if ((err = encode_one(e, kvs[i].key, depth + 1)))
return err;
const char *sep = e->tablen ? ": " : ":";
if (dst_buffer_push_cstring(e->buffer, sep))
if (janet_buffer_push_cstring(e->buffer, sep))
goto overflow;
if ((err = encode_one(e, kvs[i].value, depth + 1)))
return err;
if (dst_buffer_push_u8(e->buffer, ','))
if (janet_buffer_push_u8(e->buffer, ','))
goto overflow;
}
e->indent--;
@ -540,7 +540,7 @@ static const char *encode_one(Encoder *e, Dst x, int depth) {
e->buffer->count--;
if ((err = encode_newline(e))) return err;
}
if (dst_buffer_push_u8(e->buffer, '}')) goto overflow;
if (janet_buffer_push_u8(e->buffer, '}')) goto overflow;
}
break;
}
@ -555,42 +555,42 @@ invalidutf8:
return "string contains invalid utf-8";
}
static int json_encode(DstArgs args) {
DST_MINARITY(args, 1);
DST_MAXARITY(args, 3);
static int json_encode(JanetArgs args) {
JANET_MINARITY(args, 1);
JANET_MAXARITY(args, 3);
Encoder e;
e.indent = 0;
e.buffer = dst_buffer(10);
e.buffer = janet_buffer(10);
e.tab = NULL;
e.newline = NULL;
e.tablen = 0;
e.newlinelen = 0;
if (args.n >= 2) {
DST_ARG_BYTES(e.tab, e.tablen, args, 1);
JANET_ARG_BYTES(e.tab, e.tablen, args, 1);
if (args.n >= 3) {
DST_ARG_BYTES(e.newline, e.newlinelen, args, 2);
JANET_ARG_BYTES(e.newline, e.newlinelen, args, 2);
} else {
e.newline = (const uint8_t *)"\r\n";
e.newlinelen = 1;
}
}
const char *err = encode_one(&e, args.v[0], 0);
if (err) DST_THROW(args, err);
DST_RETURN_BUFFER(args, e.buffer);
if (err) JANET_THROW(args, err);
JANET_RETURN_BUFFER(args, e.buffer);
}
/****************/
/* Module Entry */
/****************/
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"encode", json_encode},
{"decode", json_decode},
{NULL, NULL}
};
DST_MODULE_ENTRY(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, "json", cfuns);
JANET_MODULE_ENTRY(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, "json", cfuns);
return 0;
}

172
natives/sqlite3/main.c
View File

@ -21,7 +21,7 @@
*/
#include "sqlite3.h"
#include <dst/dst.h>
#include <janet/janet.h>
#define FLAG_CLOSED 1
@ -48,39 +48,39 @@ static int gcsqlite(void *p, size_t s) {
return 0;
}
static const DstAbstractType sql_conn_type = {
static const JanetAbstractType sql_conn_type = {
":sqlite3.connection",
gcsqlite,
NULL,
};
/* Open a new database connection */
static int sql_open(DstArgs args) {
static int sql_open(JanetArgs args) {
sqlite3 *conn;
const uint8_t *filename;
int status;
DST_FIXARITY(args, 1);
DST_ARG_STRING(filename, args, 0);
JANET_FIXARITY(args, 1);
JANET_ARG_STRING(filename, args, 0);
status = sqlite3_open((const char *)filename, &conn);
if (status == SQLITE_OK) {
Db *db = (Db *) dst_abstract(&sql_conn_type, sizeof(Db));
Db *db = (Db *) janet_abstract(&sql_conn_type, sizeof(Db));
db->handle = conn;
db->flags = 0;
DST_RETURN_ABSTRACT(args, db);
JANET_RETURN_ABSTRACT(args, db);
} else {
const char *err = sqlite3_errmsg(conn);
DST_THROW(args, err);
JANET_THROW(args, err);
}
}
/* Close a database connection */
static int sql_close(DstArgs args) {
static int sql_close(JanetArgs args) {
Db *db;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &sql_conn_type);
db = (Db *)dst_unwrap_abstract(args.v[0]);
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
db = (Db *)janet_unwrap_abstract(args.v[0]);
closedb(db);
DST_RETURN_NIL(args);
JANET_RETURN_NIL(args);
}
/* Check for embedded NULL bytes */
@ -93,31 +93,31 @@ static int has_null(const uint8_t *str, int32_t len) {
}
/* Bind a single parameter */
static const char *bind1(sqlite3_stmt *stmt, int index, Dst value) {
static const char *bind1(sqlite3_stmt *stmt, int index, Janet value) {
int res;
switch (dst_type(value)) {
switch (janet_type(value)) {
default:
return "invalid sql value";
case DST_NIL:
case JANET_NIL:
res = sqlite3_bind_null(stmt, index);
break;
case DST_FALSE:
case JANET_FALSE:
res = sqlite3_bind_int(stmt, index, 0);
break;
case DST_TRUE:
case JANET_TRUE:
res = sqlite3_bind_int(stmt, index, 1);
break;
case DST_REAL:
res = sqlite3_bind_double(stmt, index, dst_unwrap_real(value));
case JANET_REAL:
res = sqlite3_bind_double(stmt, index, janet_unwrap_real(value));
break;
case DST_INTEGER:
res = sqlite3_bind_int64(stmt, index, dst_unwrap_integer(value));
case JANET_INTEGER:
res = sqlite3_bind_int64(stmt, index, janet_unwrap_integer(value));
break;
case DST_STRING:
case DST_SYMBOL:
case JANET_STRING:
case JANET_SYMBOL:
{
const uint8_t *str = dst_unwrap_string(value);
int32_t len = dst_string_length(str);
const uint8_t *str = janet_unwrap_string(value);
int32_t len = janet_string_length(str);
if (has_null(str, len)) {
return "cannot have embedded nulls in text values";
} else {
@ -125,9 +125,9 @@ static const char *bind1(sqlite3_stmt *stmt, int index, Dst value) {
}
}
break;
case DST_BUFFER:
case JANET_BUFFER:
{
DstBuffer *buffer = dst_unwrap_buffer(value);
JanetBuffer *buffer = janet_unwrap_buffer(value);
res = sqlite3_bind_blob(stmt, index, buffer->data, buffer->count, SQLITE_STATIC);
}
break;
@ -140,13 +140,13 @@ static const char *bind1(sqlite3_stmt *stmt, int index, Dst value) {
}
/* Bind many parameters */
static const char *bindmany(sqlite3_stmt *stmt, Dst params) {
static const char *bindmany(sqlite3_stmt *stmt, Janet params) {
/* parameters */
const Dst *seq;
const DstKV *kvs;
const Janet *seq;
const JanetKV *kvs;
int32_t len, cap;
int limitindex = sqlite3_bind_parameter_count(stmt);
if (dst_indexed_view(params, &seq, &len)) {
if (janet_indexed_view(params, &seq, &len)) {
if (len > limitindex + 1) {
return "invalid index in sql parameters";
}
@ -156,23 +156,23 @@ static const char *bindmany(sqlite3_stmt *stmt, Dst params) {
return err;
}
}
} else if (dst_dictionary_view(params, &kvs, &len, &cap)) {
} else if (janet_dictionary_view(params, &kvs, &len, &cap)) {
for (int i = 0; i < cap; i++) {
int index = 0;
switch (dst_type(kvs[i].key)) {
switch (janet_type(kvs[i].key)) {
default:
/* Will fail */
break;
case DST_NIL:
case JANET_NIL:
/* Will skip as nil keys indicate empty hash table slot */
continue;
case DST_INTEGER:
index = dst_unwrap_integer(kvs[i].key);
case JANET_INTEGER:
index = janet_unwrap_integer(kvs[i].key);
break;
case DST_STRING:
case DST_SYMBOL:
case JANET_STRING:
case JANET_SYMBOL:
{
const uint8_t *s = dst_unwrap_string(kvs[i].key);
const uint8_t *s = janet_unwrap_string(kvs[i].key);
index = sqlite3_bind_parameter_index(
stmt,
(const char *)s);
@ -209,57 +209,57 @@ static const char *execute(sqlite3_stmt *stmt) {
}
/* Execute and return values from prepared statement */
static const char *execute_collect(sqlite3_stmt *stmt, DstArray *rows) {
static const char *execute_collect(sqlite3_stmt *stmt, JanetArray *rows) {
/* Count number of columns in result */
int ncol = sqlite3_column_count(stmt);
int status;
const char *ret = NULL;
/* Get column names */
Dst *tupstart = dst_tuple_begin(ncol);
Janet *tupstart = janet_tuple_begin(ncol);
for (int i = 0; i < ncol; i++) {
tupstart[i] = dst_cstringv(sqlite3_column_name(stmt, i));
tupstart[i] = janet_cstringv(sqlite3_column_name(stmt, i));
}
const Dst *colnames = dst_tuple_end(tupstart);
const Janet *colnames = janet_tuple_end(tupstart);
do {
status = sqlite3_step(stmt);
if (status == SQLITE_ROW) {
DstKV *row = dst_struct_begin(ncol);
JanetKV *row = janet_struct_begin(ncol);
for (int i = 0; i < ncol; i++) {
int t = sqlite3_column_type(stmt, i);
Dst value;
Janet value;
switch (t) {
case SQLITE_NULL:
value = dst_wrap_nil();
value = janet_wrap_nil();
break;
case SQLITE_INTEGER:
value = dst_wrap_integer(sqlite3_column_int(stmt, i));
value = janet_wrap_integer(sqlite3_column_int(stmt, i));
break;
case SQLITE_FLOAT:
value = dst_wrap_real(sqlite3_column_double(stmt, i));
value = janet_wrap_real(sqlite3_column_double(stmt, i));
break;
case SQLITE_TEXT:
{
int nbytes = sqlite3_column_bytes(stmt, i) - 1;
uint8_t *str = dst_string_begin(nbytes);
uint8_t *str = janet_string_begin(nbytes);
memcpy(str, sqlite3_column_text(stmt, i), nbytes);
value = dst_wrap_string(dst_string_end(str));
value = janet_wrap_string(janet_string_end(str));
}
break;
case SQLITE_BLOB:
{
int nbytes = sqlite3_column_bytes(stmt, i);
DstBuffer *b = dst_buffer(nbytes);
JanetBuffer *b = janet_buffer(nbytes);
memcpy(b->data, sqlite3_column_blob(stmt, i), nbytes);
b->count = nbytes;
value = dst_wrap_buffer(b);
value = janet_wrap_buffer(b);
}
break;
}
dst_struct_put(row, colnames[i], value);
janet_struct_put(row, colnames[i], value);
}
dst_array_push(rows, dst_wrap_struct(dst_struct_end(row)));
janet_array_push(rows, janet_wrap_struct(janet_struct_end(row)));
}
} while (status == SQLITE_ROW);
@ -272,24 +272,24 @@ static const char *execute_collect(sqlite3_stmt *stmt, DstArray *rows) {
}
/* Evaluate a string of sql */
static int sql_eval(DstArgs args) {
static int sql_eval(JanetArgs args) {
const char *err;
sqlite3_stmt *stmt = NULL, *stmt_next = NULL;
const uint8_t *query;
DST_MINARITY(args, 2);
DST_MAXARITY(args, 3);
DST_CHECKABSTRACT(args, 0, &sql_conn_type);
Db *db = (Db *)dst_unwrap_abstract(args.v[0]);
JANET_MINARITY(args, 2);
JANET_MAXARITY(args, 3);
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
if (db->flags & FLAG_CLOSED) {
DST_THROW(args, MSG_DB_CLOSED);
JANET_THROW(args, MSG_DB_CLOSED);
}
DST_ARG_STRING(query, args, 1);
if (has_null(query, dst_string_length(query))) {
JANET_ARG_STRING(query, args, 1);
if (has_null(query, janet_string_length(query))) {
err = "cannot have embedded NULL in sql statememts";
goto error;
}
DstArray *rows = dst_array(10);
JanetArray *rows = janet_array(10);
const char *c = (const char *)query;
/* Evaluate all statements in a loop */
@ -326,12 +326,12 @@ static int sql_eval(DstArgs args) {
} while (NULL != stmt);
/* Good return path */
DST_RETURN_ARRAY(args, rows);
JANET_RETURN_ARRAY(args, rows);
error:
if (stmt) sqlite3_finalize(stmt);
if (stmt_next) sqlite3_finalize(stmt_next);
DST_THROW(args, err);
JANET_THROW(args, err);
}
/* Convert int64_t to a string */
@ -339,8 +339,8 @@ static const uint8_t *coerce_int64(int64_t x) {
uint8_t bytes[40];
int i = 0;
/* Edge cases */
if (x == 0) return dst_cstring("0");
if (x == INT64_MIN) return dst_cstring("-9,223,372,036,854,775,808");
if (x == 0) return janet_cstring("0");
if (x == INT64_MIN) return janet_cstring("-9,223,372,036,854,775,808");
/* Negative becomes pos */
if (x < 0) {
bytes[i++] = '-';
@ -351,40 +351,40 @@ static const uint8_t *coerce_int64(int64_t x) {
x = x / 10;
}
bytes[i] = '\0';
return dst_string(bytes, i);
return janet_string(bytes, i);
}
/* Gets the last inserted row id */
static int sql_last_insert_rowid(DstArgs args) {
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &sql_conn_type);
Db *db = (Db *)dst_unwrap_abstract(args.v[0]);
static int sql_last_insert_rowid(JanetArgs args) {
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
if (db->flags & FLAG_CLOSED) {
DST_THROW(args, MSG_DB_CLOSED);
JANET_THROW(args, MSG_DB_CLOSED);
}
sqlite3_int64 id = sqlite3_last_insert_rowid(db->handle);
if (id >= INT32_MIN && id <= INT32_MAX) {
DST_RETURN_INTEGER(args, (int32_t) id);
JANET_RETURN_INTEGER(args, (int32_t) id);
}
/* Convert to string */
DST_RETURN_STRING(args, coerce_int64(id));
JANET_RETURN_STRING(args, coerce_int64(id));
}
/* Get the sqlite3 errcode */
static int sql_error_code(DstArgs args) {
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &sql_conn_type);
Db *db = (Db *)dst_unwrap_abstract(args.v[0]);
static int sql_error_code(JanetArgs args) {
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
if (db->flags & FLAG_CLOSED) {
DST_THROW(args, MSG_DB_CLOSED);
JANET_THROW(args, MSG_DB_CLOSED);
}
int errcode = sqlite3_errcode(db->handle);
DST_RETURN_INTEGER(args, errcode);
JANET_RETURN_INTEGER(args, errcode);
}
/*****************************************************************************/
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"open", sql_open},
{"close", sql_close},
{"eval", sql_eval},
@ -393,8 +393,8 @@ static const DstReg cfuns[] = {
{NULL, NULL}
};
DST_MODULE_ENTRY(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, "sqlite3", cfuns);
JANET_MODULE_ENTRY(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, "sqlite3", cfuns);
return 0;
}

10
src/core/abstract.c
View File

@ -20,14 +20,14 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "gc.h"
/* Create new userdata */
void *dst_abstract(const DstAbstractType *atype, size_t size) {
char *data = dst_gcalloc(DST_MEMORY_ABSTRACT, sizeof(DstAbstractHeader) + size);
DstAbstractHeader *header = (DstAbstractHeader *)data;
void *a = data + sizeof(DstAbstractHeader);
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
char *data = janet_gcalloc(JANET_MEMORY_ABSTRACT, sizeof(JanetAbstractHeader) + size);
JanetAbstractHeader *header = (JanetAbstractHeader *)data;
void *a = data + sizeof(JanetAbstractHeader);
header->size = size;
header->type = atype;
return a;

198
src/core/array.c
View File

@ -20,17 +20,17 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "gc.h"
#include <string.h>
/* Initializes an array */
DstArray *dst_array_init(DstArray *array, int32_t capacity) {
Dst *data = NULL;
JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
Janet *data = NULL;
if (capacity > 0) {
data = (Dst *) malloc(sizeof(Dst) * capacity);
data = (Janet *) malloc(sizeof(Janet) * capacity);
if (NULL == data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
}
array->count = 0;
@ -39,209 +39,209 @@ DstArray *dst_array_init(DstArray *array, int32_t capacity) {
return array;
}
void dst_array_deinit(DstArray *array) {
void janet_array_deinit(JanetArray *array) {
free(array->data);
}
/* Creates a new array */
DstArray *dst_array(int32_t capacity) {
DstArray *array = dst_gcalloc(DST_MEMORY_ARRAY, sizeof(DstArray));
return dst_array_init(array, capacity);
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
return janet_array_init(array, capacity);
}
/* Creates a new array from n elements. */
DstArray *dst_array_n(const Dst *elements, int32_t n) {
DstArray *array = dst_gcalloc(DST_MEMORY_ARRAY, sizeof(DstArray));
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
array->capacity = n;
array->count = n;
array->data = malloc(sizeof(Dst) * n);
array->data = malloc(sizeof(Janet) * n);
if (!array->data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
memcpy(array->data, elements, sizeof(Dst) * n);
memcpy(array->data, elements, sizeof(Janet) * n);
return array;
}
/* Ensure the array has enough capacity for elements */
void dst_array_ensure(DstArray *array, int32_t capacity) {
Dst *newData;
Dst *old = array->data;
void janet_array_ensure(JanetArray *array, int32_t capacity) {
Janet *newData;
Janet *old = array->data;
if (capacity <= array->capacity) return;
newData = realloc(old, capacity * sizeof(Dst));
newData = realloc(old, capacity * sizeof(Janet));
if (NULL == newData) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
array->data = newData;
array->capacity = capacity;
}
/* Set the count of an array. Extend with nil if needed. */
void dst_array_setcount(DstArray *array, int32_t count) {
void janet_array_setcount(JanetArray *array, int32_t count) {
if (count < 0)
return;
if (count > array->count) {
int32_t i;
dst_array_ensure(array, count);
janet_array_ensure(array, count);
for (i = array->count; i < count; i++) {
array->data[i] = dst_wrap_nil();
array->data[i] = janet_wrap_nil();
}
}
array->count = count;
}
/* Push a value to the top of the array */
void dst_array_push(DstArray *array, Dst x) {
void janet_array_push(JanetArray *array, Janet x) {
int32_t newcount = array->count + 1;
if (newcount >= array->capacity) {
dst_array_ensure(array, newcount * 2);
janet_array_ensure(array, newcount * 2);
}
array->data[array->count] = x;
array->count = newcount;
}
/* Pop a value from the top of the array */
Dst dst_array_pop(DstArray *array) {
Janet janet_array_pop(JanetArray *array) {
if (array->count) {
return array->data[--array->count];
} else {
return dst_wrap_nil();
return janet_wrap_nil();
}
}
/* Look at the last value in the array */
Dst dst_array_peek(DstArray *array) {
Janet janet_array_peek(JanetArray *array) {
if (array->count) {
return array->data[array->count - 1];
} else {
return dst_wrap_nil();
return janet_wrap_nil();
}
}
/* C Functions */
static int cfun_new(DstArgs args) {
static int cfun_new(JanetArgs args) {
int32_t cap;
DstArray *array;
DST_FIXARITY(args, 1);
DST_ARG_INTEGER(cap, args, 0);
array = dst_array(cap);
DST_RETURN_ARRAY(args, array);
JanetArray *array;
JANET_FIXARITY(args, 1);
JANET_ARG_INTEGER(cap, args, 0);
array = janet_array(cap);
JANET_RETURN_ARRAY(args, array);
}
static int cfun_pop(DstArgs args) {
DstArray *array;
DST_FIXARITY(args, 1);
DST_ARG_ARRAY(array, args, 0);
DST_RETURN(args, dst_array_pop(array));
static int cfun_pop(JanetArgs args) {
JanetArray *array;
JANET_FIXARITY(args, 1);
JANET_ARG_ARRAY(array, args, 0);
JANET_RETURN(args, janet_array_pop(array));
}
static int cfun_peek(DstArgs args) {
DstArray *array;
DST_FIXARITY(args, 1);
DST_ARG_ARRAY(array, args, 0);
DST_RETURN(args, dst_array_peek(array));
static int cfun_peek(JanetArgs args) {
JanetArray *array;
JANET_FIXARITY(args, 1);
JANET_ARG_ARRAY(array, args, 0);
JANET_RETURN(args, janet_array_peek(array));
}
static int cfun_push(DstArgs args) {
DstArray *array;
static int cfun_push(JanetArgs args) {
JanetArray *array;
int32_t newcount;
DST_MINARITY(args, 1);
DST_ARG_ARRAY(array, args, 0);
JANET_MINARITY(args, 1);
JANET_ARG_ARRAY(array, args, 0);
newcount = array->count - 1 + args.n;
dst_array_ensure(array, newcount);
if (args.n > 1) memcpy(array->data + array->count, args.v + 1, (args.n - 1) * sizeof(Dst));
janet_array_ensure(array, newcount);
if (args.n > 1) memcpy(array->data + array->count, args.v + 1, (args.n - 1) * sizeof(Janet));
array->count = newcount;
DST_RETURN(args, args.v[0]);
JANET_RETURN(args, args.v[0]);
}
static int cfun_setcount(DstArgs args) {
DstArray *array;
static int cfun_setcount(JanetArgs args) {
JanetArray *array;
int32_t newcount;
DST_FIXARITY(args, 2);
DST_ARG_ARRAY(array, args, 0);
DST_ARG_INTEGER(newcount, args, 1);
if (newcount < 0) DST_THROW(args, "expected positive integer");
dst_array_setcount(array, newcount);
DST_RETURN(args, args.v[0]);
JANET_FIXARITY(args, 2);
JANET_ARG_ARRAY(array, args, 0);
JANET_ARG_INTEGER(newcount, args, 1);
if (newcount < 0) JANET_THROW(args, "expected positive integer");
janet_array_setcount(array, newcount);
JANET_RETURN(args, args.v[0]);
}
static int cfun_ensure(DstArgs args) {
DstArray *array;
static int cfun_ensure(JanetArgs args) {
JanetArray *array;
int32_t newcount;
DST_FIXARITY(args, 2);
DST_ARG_ARRAY(array, args, 0);
DST_ARG_INTEGER(newcount, args, 1);
if (newcount < 0) DST_THROW(args, "expected positive integer");
dst_array_ensure(array, newcount);
DST_RETURN(args, args.v[0]);
JANET_FIXARITY(args, 2);
JANET_ARG_ARRAY(array, args, 0);
JANET_ARG_INTEGER(newcount, args, 1);
if (newcount < 0) JANET_THROW(args, "expected positive integer");
janet_array_ensure(array, newcount);
JANET_RETURN(args, args.v[0]);
}
static int cfun_slice(DstArgs args) {
const Dst *vals;
static int cfun_slice(JanetArgs args) {
const Janet *vals;
int32_t len;
DstArray *ret;
JanetArray *ret;
int32_t start, end;
DST_MINARITY(args, 1);
DST_MAXARITY(args, 3);
if (!dst_indexed_view(args.v[0], &vals, &len))
DST_THROW(args, "expected array|tuple");
JANET_MINARITY(args, 1);
JANET_MAXARITY(args, 3);
if (!janet_indexed_view(args.v[0], &vals, &len))
JANET_THROW(args, "expected array|tuple");
/* Get start */
if (args.n < 2) {
start = 0;
} else if (dst_checktype(args.v[1], DST_INTEGER)) {
start = dst_unwrap_integer(args.v[1]);
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
DST_THROW(args, "expected integer");
JANET_THROW(args, "expected integer");
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (dst_checktype(args.v[2], DST_INTEGER)) {
end = dst_unwrap_integer(args.v[2]);
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
DST_THROW(args, "expected integer");
JANET_THROW(args, "expected integer");
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;
if (end >= start) {
int32_t i, j;
ret = dst_array(end - start);
ret = janet_array(end - start);
for (j = 0, i = start; i < end; j++, i++) {
ret->data[j] = vals[i];
}
ret->count = j;
} else {
ret = dst_array(0);
ret = janet_array(0);
}
DST_RETURN_ARRAY(args, ret);
JANET_RETURN_ARRAY(args, ret);
}
static int cfun_concat(DstArgs args) {
static int cfun_concat(JanetArgs args) {
int32_t i;
DstArray *array;
DST_MINARITY(args, 1);
DST_ARG_ARRAY(array, args, 0);
JanetArray *array;
JANET_MINARITY(args, 1);
JANET_ARG_ARRAY(array, args, 0);
for (i = 1; i < args.n; i++) {
switch (dst_type(args.v[i])) {
switch (janet_type(args.v[i])) {
default:
dst_array_push(array, args.v[i]);
janet_array_push(array, args.v[i]);
break;
case DST_ARRAY:
case DST_TUPLE:
case JANET_ARRAY:
case JANET_TUPLE:
{
int32_t j, len;
const Dst *vals;
dst_indexed_view(args.v[i], &vals, &len);
const Janet *vals;
janet_indexed_view(args.v[i], &vals, &len);
for (j = 0; j < len; j++)
dst_array_push(array, vals[j]);
janet_array_push(array, vals[j]);
}
break;
}
}
DST_RETURN_ARRAY(args, array);
JANET_RETURN_ARRAY(args, array);
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"array.new", cfun_new},
{"array.pop", cfun_pop},
{"array.peek", cfun_peek},
@ -254,8 +254,8 @@ static const DstReg cfuns[] = {
};
/* Load the array module */
int dst_lib_array(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_array(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

926
src/core/asm.c
View File

File diff suppressed because it is too large Load Diff

168
src/core/buffer.c
View File

@ -20,16 +20,16 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "gc.h"
/* Initialize a buffer */
DstBuffer *dst_buffer_init(DstBuffer *buffer, int32_t capacity) {
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity > 0) {
data = malloc(sizeof(uint8_t) * capacity);
if (NULL == data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
}
buffer->count = 0;
@ -39,36 +39,36 @@ DstBuffer *dst_buffer_init(DstBuffer *buffer, int32_t capacity) {
}
/* Deinitialize a buffer (free data memory) */
void dst_buffer_deinit(DstBuffer *buffer) {
void janet_buffer_deinit(JanetBuffer *buffer) {
free(buffer->data);
}
/* Initialize a buffer */
DstBuffer *dst_buffer(int32_t capacity) {
DstBuffer *buffer = dst_gcalloc(DST_MEMORY_BUFFER, sizeof(DstBuffer));
return dst_buffer_init(buffer, capacity);
JanetBuffer *janet_buffer(int32_t capacity) {
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
return janet_buffer_init(buffer, capacity);
}
/* Ensure that the buffer has enough internal capacity */
void dst_buffer_ensure(DstBuffer *buffer, int32_t capacity) {
void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity) {
uint8_t *new_data;
uint8_t *old = buffer->data;
if (capacity <= buffer->capacity) return;
new_data = realloc(old, capacity * sizeof(uint8_t));
if (NULL == new_data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
buffer->data = new_data;
buffer->capacity = capacity;
}
/* Ensure that the buffer has enough internal capacity */
void dst_buffer_setcount(DstBuffer *buffer, int32_t count) {
void janet_buffer_setcount(JanetBuffer *buffer, int32_t count) {
if (count < 0)
return;
if (count > buffer->count) {
int32_t oldcount = buffer->count;
dst_buffer_ensure(buffer, count);
janet_buffer_ensure(buffer, count);
memset(buffer->data + oldcount, 0, count - oldcount);
}
buffer->count = count;
@ -76,7 +76,7 @@ void dst_buffer_setcount(DstBuffer *buffer, int32_t count) {
/* Adds capacity for enough extra bytes to the buffer. Ensures that the
* next n bytes pushed to the buffer will not cause a reallocation */
int dst_buffer_extra(DstBuffer *buffer, int32_t n) {
int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
/* Check for buffer overflow */
if ((int64_t)n + buffer->count > INT32_MAX) {
return -1;
@ -86,7 +86,7 @@ int dst_buffer_extra(DstBuffer *buffer, int32_t n) {
int32_t new_capacity = new_size * 2;
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
if (NULL == new_data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
buffer->data = new_data;
buffer->capacity = new_capacity;
@ -95,35 +95,35 @@ int dst_buffer_extra(DstBuffer *buffer, int32_t n) {
}
/* Push a cstring to buffer */
int dst_buffer_push_cstring(DstBuffer *buffer, const char *cstring) {
int janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
int32_t len = 0;
while (cstring[len]) ++len;
return dst_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
return janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
}
/* Push multiple bytes into the buffer */
int dst_buffer_push_bytes(DstBuffer *buffer, const uint8_t *string, int32_t length) {
if (dst_buffer_extra(buffer, length)) return -1;
int janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
if (janet_buffer_extra(buffer, length)) return -1;
memcpy(buffer->data + buffer->count, string, length);
buffer->count += length;
return 0;
}
int dst_buffer_push_string(DstBuffer *buffer, const uint8_t *string) {
return dst_buffer_push_bytes(buffer, string, dst_string_length(string));
int janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
return janet_buffer_push_bytes(buffer, string, janet_string_length(string));
}
/* Push a single byte to the buffer */
int dst_buffer_push_u8(DstBuffer *buffer, uint8_t byte) {
if (dst_buffer_extra(buffer, 1)) return -1;
int janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
if (janet_buffer_extra(buffer, 1)) return -1;
buffer->data[buffer->count] = byte;
buffer->count++;
return 0;
}
/* Push a 16 bit unsigned integer to the buffer */
int dst_buffer_push_u16(DstBuffer *buffer, uint16_t x) {
if (dst_buffer_extra(buffer, 2)) return -1;
int janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
if (janet_buffer_extra(buffer, 2)) return -1;
buffer->data[buffer->count] = x & 0xFF;
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
buffer->count += 2;
@ -131,8 +131,8 @@ int dst_buffer_push_u16(DstBuffer *buffer, uint16_t x) {
}
/* Push a 32 bit unsigned integer to the buffer */
int dst_buffer_push_u32(DstBuffer *buffer, uint32_t x) {
if (dst_buffer_extra(buffer, 4)) return -1;
int janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
if (janet_buffer_extra(buffer, 4)) return -1;
buffer->data[buffer->count] = x & 0xFF;
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
@ -142,8 +142,8 @@ int dst_buffer_push_u32(DstBuffer *buffer, uint32_t x) {
}
/* Push a 64 bit unsigned integer to the buffer */
int dst_buffer_push_u64(DstBuffer *buffer, uint64_t x) {
if (dst_buffer_extra(buffer, 8)) return -1;
int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
if (janet_buffer_extra(buffer, 8)) return -1;
buffer->data[buffer->count] = x & 0xFF;
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
@ -158,114 +158,114 @@ int dst_buffer_push_u64(DstBuffer *buffer, uint64_t x) {
/* C functions */
static int cfun_new(DstArgs args) {
static int cfun_new(JanetArgs args) {
int32_t cap;
DstBuffer *buffer;
DST_FIXARITY(args, 1);
DST_ARG_INTEGER(cap, args, 0);
buffer = dst_buffer(cap);
DST_RETURN_BUFFER(args, buffer);
JanetBuffer *buffer;
JANET_FIXARITY(args, 1);
JANET_ARG_INTEGER(cap, args, 0);
buffer = janet_buffer(cap);
JANET_RETURN_BUFFER(args, buffer);
}
static int cfun_u8(DstArgs args) {
static int cfun_u8(JanetArgs args) {
int32_t i;
DstBuffer *buffer;
DST_MINARITY(args, 1);
DST_ARG_BUFFER(buffer, args, 0);
JanetBuffer *buffer;
JANET_MINARITY(args, 1);
JANET_ARG_BUFFER(buffer, args, 0);
for (i = 1; i < args.n; i++) {
int32_t integer;
DST_ARG_INTEGER(integer, args, i);
if (dst_buffer_push_u8(buffer, (uint8_t) (integer & 0xFF)))
DST_THROW(args, "buffer overflow");
JANET_ARG_INTEGER(integer, args, i);
if (janet_buffer_push_u8(buffer, (uint8_t) (integer & 0xFF)))
JANET_THROW(args, "buffer overflow");
}
DST_RETURN(args, args.v[0]);
JANET_RETURN(args, args.v[0]);
}
static int cfun_int(DstArgs args) {
static int cfun_int(JanetArgs args) {
int32_t i;
DstBuffer *buffer;
DST_MINARITY(args, 1);
DST_ARG_BUFFER(buffer, args, 0);
JanetBuffer *buffer;
JANET_MINARITY(args, 1);
JANET_ARG_BUFFER(buffer, args, 0);
for (i = 1; i < args.n; i++) {
int32_t integer;
DST_ARG_INTEGER(integer, args, i);
if (dst_buffer_push_u32(buffer, (uint32_t) integer))
DST_THROW(args, "buffer overflow");
JANET_ARG_INTEGER(integer, args, i);
if (janet_buffer_push_u32(buffer, (uint32_t) integer))
JANET_THROW(args, "buffer overflow");
}
DST_RETURN(args, args.v[0]);
JANET_RETURN(args, args.v[0]);
}
static int cfun_chars(DstArgs args) {
static int cfun_chars(JanetArgs args) {
int32_t i;
DstBuffer *buffer;
DST_MINARITY(args, 1);
DST_ARG_BUFFER(buffer, args, 0);
JanetBuffer *buffer;
JANET_MINARITY(args, 1);
JANET_ARG_BUFFER(buffer, args, 0);
for (i = 1; i < args.n; i++) {
int32_t len;
const uint8_t *str;
DST_ARG_BYTES(str, len, args, i);
if (dst_buffer_push_bytes(buffer, str, len))
DST_THROW(args, "buffer overflow");
JANET_ARG_BYTES(str, len, args, i);
if (janet_buffer_push_bytes(buffer, str, len))
JANET_THROW(args, "buffer overflow");
}
DST_RETURN(args, args.v[0]);
JANET_RETURN(args, args.v[0]);
}
static int cfun_clear(DstArgs args) {
DstBuffer *buffer;
DST_FIXARITY(args, 1);
DST_ARG_BUFFER(buffer, args, 0);
static int cfun_clear(JanetArgs args) {
JanetBuffer *buffer;
JANET_FIXARITY(args, 1);
JANET_ARG_BUFFER(buffer, args, 0);
buffer->count = 0;
DST_RETURN(args, args.v[0]);
JANET_RETURN(args, args.v[0]);
}
static int cfun_popn(DstArgs args) {
DstBuffer *buffer;
static int cfun_popn(JanetArgs args) {
JanetBuffer *buffer;
int32_t n;
DST_FIXARITY(args, 2);
DST_ARG_BUFFER(buffer, args, 0);
DST_ARG_INTEGER(n, args, 1);
JANET_FIXARITY(args, 2);
JANET_ARG_BUFFER(buffer, args, 0);
JANET_ARG_INTEGER(n, args, 1);
if (buffer->count < n) {
buffer->count = 0;
} else {
buffer->count -= n;
}
DST_RETURN(args, args.v[0]);
JANET_RETURN(args, args.v[0]);
}
static int cfun_slice(DstArgs args) {
static int cfun_slice(JanetArgs args) {
const uint8_t *data;
int32_t len, start, end;
DstBuffer *ret;
DST_ARG_BYTES(data, len, args, 0);
JanetBuffer *ret;
JANET_ARG_BYTES(data, len, args, 0);
/* Get start */
if (args.n < 2) {
start = 0;
} else if (dst_checktype(args.v[1], DST_INTEGER)) {
start = dst_unwrap_integer(args.v[1]);
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
DST_THROW(args, "expected integer");
JANET_THROW(args, "expected integer");
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (dst_checktype(args.v[2], DST_INTEGER)) {
end = dst_unwrap_integer(args.v[2]);
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
DST_THROW(args, "expected integer");
JANET_THROW(args, "expected integer");
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;
if (end >= start) {
ret = dst_buffer(end - start);
ret = janet_buffer(end - start);
memcpy(ret->data, data + start, end - start);
ret->count = end - start;
} else {
ret = dst_buffer(0);
ret = janet_buffer(0);
}
DST_RETURN_BUFFER(args, ret);
JANET_RETURN_BUFFER(args, ret);
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"buffer.new", cfun_new},
{"buffer.push-byte", cfun_u8},
{"buffer.push-integer", cfun_int},
@ -276,8 +276,8 @@ static const DstReg cfuns[] = {
{NULL, NULL}
};
int dst_lib_buffer(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_buffer(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

226
src/core/bytecode.c
View File

@ -20,99 +20,99 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "gc.h"
/* Look up table for instructions */
enum DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT] = {
DIT_0, /* DOP_NOOP, */
DIT_S, /* DOP_ERROR, */
DIT_ST, /* DOP_TYPECHECK, */
DIT_S, /* DOP_RETURN, */
DIT_0, /* DOP_RETURN_NIL, */
DIT_SSS, /* DOP_ADD_INTEGER, */
DIT_SSI, /* DOP_ADD_IMMEDIATE, */
DIT_SSS, /* DOP_ADD_REAL, */
DIT_SSS, /* DOP_ADD, */
DIT_SSS, /* DOP_SUBTRACT_INTEGER, */
DIT_SSS, /* DOP_SUBTRACT_REAL, */
DIT_SSS, /* DOP_SUBTRACT, */
DIT_SSS, /* DOP_MULTIPLY_INTEGER, */
DIT_SSI, /* DOP_MULTIPLY_IMMEDIATE, */
DIT_SSS, /* DOP_MULTIPLY_REAL, */
DIT_SSS, /* DOP_MULTIPLY, */
DIT_SSS, /* DOP_DIVIDE_INTEGER, */
DIT_SSI, /* DOP_DIVIDE_IMMEDIATE, */
DIT_SSS, /* DOP_DIVIDE_REAL, */
DIT_SSS, /* DOP_DIVIDE, */
DIT_SSS, /* DOP_BAND, */
DIT_SSS, /* DOP_BOR, */
DIT_SSS, /* DOP_BXOR, */
DIT_SS, /* DOP_BNOT, */
DIT_SSS, /* DOP_SHIFT_LEFT, */
DIT_SSI, /* DOP_SHIFT_LEFT_IMMEDIATE, */
DIT_SSS, /* DOP_SHIFT_RIGHT, */
DIT_SSI, /* DOP_SHIFT_RIGHT_IMMEDIATE, */
DIT_SSS, /* DOP_SHIFT_RIGHT_UNSIGNED, */
DIT_SSU, /* DOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, */
DIT_SS, /* DOP_MOVE_FAR, */
DIT_SS, /* DOP_MOVE_NEAR, */
DIT_L, /* DOP_JUMP, */
DIT_SL, /* DOP_JUMP_IF, */
DIT_SL, /* DOP_JUMP_IF_NOT, */
DIT_SSS, /* DOP_GREATER_THAN, */
DIT_SSS, /* DOP_GREATER_THAN_INTEGER, */
DIT_SSI, /* DOP_GREATER_THAN_IMMEDIATE, */
DIT_SSS, /* DOP_GREATER_THAN_REAL, */
DIT_SSS, /* DOP_GREATER_THAN_EQUAL_REAL, */
DIT_SSS, /* DOP_LESS_THAN, */
DIT_SSS, /* DOP_LESS_THAN_INTEGER, */
DIT_SSI, /* DOP_LESS_THAN_IMMEDIATE, */
DIT_SSS, /* DOP_LESS_THAN_REAL, */
DIT_SSS, /* DOP_LESS_THAN_EQUAL_REAL, */
DIT_SSS, /* DOP_EQUALS, */
DIT_SSS, /* DOP_EQUALS_INTEGER, */
DIT_SSI, /* DOP_EQUALS_IMMEDIATE, */
DIT_SSS, /* DOP_EQUALS_REAL, */
DIT_SSS, /* DOP_COMPARE, */
DIT_S, /* DOP_LOAD_NIL, */
DIT_S, /* DOP_LOAD_TRUE, */
DIT_S, /* DOP_LOAD_FALSE, */
DIT_SI, /* DOP_LOAD_INTEGER, */
DIT_SC, /* DOP_LOAD_CONSTANT, */
DIT_SES, /* DOP_LOAD_UPVALUE, */
DIT_S, /* DOP_LOAD_SELF, */
DIT_SES, /* DOP_SET_UPVALUE, */
DIT_SD, /* DOP_CLOSURE, */
DIT_S, /* DOP_PUSH, */
DIT_SS, /* DOP_PUSH_2, */
DIT_SSS, /* DOP_PUSH_3, */
DIT_S, /* DOP_PUSH_ARRAY, */
DIT_SS, /* DOP_CALL, */
DIT_S, /* DOP_TAILCALL, */
DIT_SSS, /* DOP_RESUME, */
DIT_SSU, /* DOP_SIGNAL, */
DIT_SSS, /* DOP_GET, */
DIT_SSS, /* DOP_PUT, */
DIT_SSU, /* DOP_GET_INDEX, */
DIT_SSU, /* DOP_PUT_INDEX, */
DIT_SS, /* DOP_LENGTH */
DIT_S, /* DOP_MAKE_ARRAY */
DIT_S, /* DOP_MAKE_BUFFER */
DIT_S, /* DOP_MAKE_TUPLE */
DIT_S, /* DOP_MAKE_STRUCT */
DIT_S, /* DOP_MAKE_TABLE */
DIT_S, /* DOP_MAKE_STRING */
DIT_SSS, /* DOP_NUMERIC_LESS_THAN */
DIT_SSS, /* DOP_NUMERIC_LESS_THAN_EQUAL */
DIT_SSS, /* DOP_NUMERIC_GREATER_THAN */
DIT_SSS, /* DOP_NUMERIC_GREATER_THAN_EQUAL */
DIT_SSS /* DOP_NUMERIC_EQUAL */
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_0, /* JOP_NOOP, */
JINT_S, /* JOP_ERROR, */
JINT_ST, /* JOP_TYPECHECK, */
JINT_S, /* JOP_RETURN, */
JINT_0, /* JOP_RETURN_NIL, */
JINT_SSS, /* JOP_ADD_INTEGER, */
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
JINT_SSS, /* JOP_ADD_REAL, */
JINT_SSS, /* JOP_ADD, */
JINT_SSS, /* JOP_SUBTRACT_INTEGER, */
JINT_SSS, /* JOP_SUBTRACT_REAL, */
JINT_SSS, /* JOP_SUBTRACT, */
JINT_SSS, /* JOP_MULTIPLY_INTEGER, */
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
JINT_SSS, /* JOP_MULTIPLY_REAL, */
JINT_SSS, /* JOP_MULTIPLY, */
JINT_SSS, /* JOP_DIVIDE_INTEGER, */
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
JINT_SSS, /* JOP_DIVIDE_REAL, */
JINT_SSS, /* JOP_DIVIDE, */
JINT_SSS, /* JOP_BAND, */
JINT_SSS, /* JOP_BOR, */
JINT_SSS, /* JOP_BXOR, */
JINT_SS, /* JOP_BNOT, */
JINT_SSS, /* JOP_SHIFT_LEFT, */
JINT_SSI, /* JOP_SHIFT_LEFT_IMMEDIATE, */
JINT_SSS, /* JOP_SHIFT_RIGHT, */
JINT_SSI, /* JOP_SHIFT_RIGHT_IMMEDIATE, */
JINT_SSS, /* JOP_SHIFT_RIGHT_UNSIGNED, */
JINT_SSU, /* JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, */
JINT_SS, /* JOP_MOVE_FAR, */
JINT_SS, /* JOP_MOVE_NEAR, */
JINT_L, /* JOP_JUMP, */
JINT_SL, /* JOP_JUMP_IF, */
JINT_SL, /* JOP_JUMP_IF_NOT, */
JINT_SSS, /* JOP_GREATER_THAN, */
JINT_SSS, /* JOP_GREATER_THAN_INTEGER, */
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
JINT_SSS, /* JOP_GREATER_THAN_REAL, */
JINT_SSS, /* JOP_GREATER_THAN_EQUAL_REAL, */
JINT_SSS, /* JOP_LESS_THAN, */
JINT_SSS, /* JOP_LESS_THAN_INTEGER, */
JINT_SSI, /* JOP_LESS_THAN_IMMEDIATE, */
JINT_SSS, /* JOP_LESS_THAN_REAL, */
JINT_SSS, /* JOP_LESS_THAN_EQUAL_REAL, */
JINT_SSS, /* JOP_EQUALS, */
JINT_SSS, /* JOP_EQUALS_INTEGER, */
JINT_SSI, /* JOP_EQUALS_IMMEDIATE, */
JINT_SSS, /* JOP_EQUALS_REAL, */
JINT_SSS, /* JOP_COMPARE, */
JINT_S, /* JOP_LOAD_NIL, */
JINT_S, /* JOP_LOAD_TRUE, */
JINT_S, /* JOP_LOAD_FALSE, */
JINT_SI, /* JOP_LOAD_INTEGER, */
JINT_SC, /* JOP_LOAD_CONSTANT, */
JINT_SES, /* JOP_LOAD_UPVALUE, */
JINT_S, /* JOP_LOAD_SELF, */
JINT_SES, /* JOP_SET_UPVALUE, */
JINT_SD, /* JOP_CLOSURE, */
JINT_S, /* JOP_PUSH, */
JINT_SS, /* JOP_PUSH_2, */
JINT_SSS, /* JOP_PUSH_3, */
JINT_S, /* JOP_PUSH_ARRAY, */
JINT_SS, /* JOP_CALL, */
JINT_S, /* JOP_TAILCALL, */
JINT_SSS, /* JOP_RESUME, */
JINT_SSU, /* JOP_SIGNAL, */
JINT_SSS, /* JOP_GET, */
JINT_SSS, /* JOP_PUT, */
JINT_SSU, /* JOP_GET_INDEX, */
JINT_SSU, /* JOP_PUT_INDEX, */
JINT_SS, /* JOP_LENGTH */
JINT_S, /* JOP_MAKE_ARRAY */
JINT_S, /* JOP_MAKE_BUFFER */
JINT_S, /* JOP_MAKE_TUPLE */
JINT_S, /* JOP_MAKE_STRUCT */
JINT_S, /* JOP_MAKE_TABLE */
JINT_S, /* JOP_MAKE_STRING */
JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
JINT_SSS, /* JOP_NUMERIC_GREATER_THAN_EQUAL */
JINT_SSS /* JOP_NUMERIC_EQUAL */
};
/* Verify some bytecode */
int32_t dst_verify(DstFuncDef *def) {
int vargs = !!(def->flags & DST_FUNCDEF_FLAG_VARARG);
int32_t janet_verify(JanetFuncDef *def) {
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
int32_t i;
int32_t maxslot = def->arity + vargs;
int32_t sc = def->slotcount;
@ -125,71 +125,71 @@ int32_t dst_verify(DstFuncDef *def) {
for (i = 0; i < def->bytecode_length; i++) {
uint32_t instr = def->bytecode[i];
/* Check for invalid instructions */
if ((instr & 0xFF) >= DOP_INSTRUCTION_COUNT) {
if ((instr & 0xFF) >= JOP_INSTRUCTION_COUNT) {
return 3;
}
enum DstInstructionType type = dst_instructions[instr & 0xFF];
enum JanetInstructionType type = janet_instructions[instr & 0xFF];
switch (type) {
case DIT_0:
case JINT_0:
continue;
case DIT_S:
case JINT_S:
{
if ((int32_t)(instr >> 8) >= sc) return 4;
continue;
}
case DIT_SI:
case DIT_SU:
case DIT_ST:
case JINT_SI:
case JINT_SU:
case JINT_ST:
{
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
continue;
}
case DIT_L:
case JINT_L:
{
int32_t jumpdest = i + (((int32_t)instr) >> 8);
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
continue;
}
case DIT_SS:
case JINT_SS:
{
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
(int32_t)(instr >> 16) >= sc) return 4;
continue;
}
case DIT_SSI:
case DIT_SSU:
case JINT_SSI:
case JINT_SSU:
{
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
continue;
}
case DIT_SL:
case JINT_SL:
{
int32_t jumpdest = i + (((int32_t)instr) >> 16);
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
continue;
}
case DIT_SSS:
case JINT_SSS:
{
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
((int32_t)(instr >> 16) & 0xFF) >= sc ||
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
continue;
}
case DIT_SD:
case JINT_SD:
{
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
continue;
}
case DIT_SC:
case JINT_SC:
{
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
continue;
}
case DIT_SES:
case JINT_SES:
{
/* How can we check the last slot index? We need info parent funcdefs. Resort
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
@ -210,11 +210,11 @@ int32_t dst_verify(DstFuncDef *def) {
switch (lastop) {
default:
return 9;
case DOP_RETURN:
case DOP_RETURN_NIL:
case DOP_JUMP:
case DOP_ERROR:
case DOP_TAILCALL:
case JOP_RETURN:
case JOP_RETURN_NIL:
case JOP_JUMP:
case JOP_ERROR:
case JOP_TAILCALL:
break;
}
}
@ -224,8 +224,8 @@ int32_t dst_verify(DstFuncDef *def) {
/* Allocate an empty funcdef. This function may have added functionality
* as commonalities between asm and compile arise. */
DstFuncDef *dst_funcdef_alloc() {
DstFuncDef *def = dst_gcalloc(DST_MEMORY_FUNCDEF, sizeof(DstFuncDef));
JanetFuncDef *janet_funcdef_alloc() {
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
def->environments = NULL;
def->constants = NULL;
def->bytecode = NULL;
@ -244,9 +244,9 @@ DstFuncDef *dst_funcdef_alloc() {
}
/* Create a simple closure from a funcdef */
DstFunction *dst_thunk(DstFuncDef *def) {
DstFunction *func = dst_gcalloc(DST_MEMORY_FUNCTION, sizeof(DstFunction));
JanetFunction *janet_thunk(JanetFuncDef *def) {
JanetFunction *func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction));
func->def = def;
dst_assert(def->environments_length == 0, "tried to create thunk that needs upvalues");
janet_assert(def->environments_length == 0, "tried to create thunk that needs upvalues");
return func;
}

260
src/core/cfuns.c
View File

@ -20,235 +20,235 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "compile.h"
#include "emit.h"
#include "vector.h"
static int fixarity0(DstFopts opts, DstSlot *args) {
static int fixarity0(JanetFopts opts, JanetSlot *args) {
(void) opts;
return dst_v_count(args) == 0;
return janet_v_count(args) == 0;
}
static int fixarity1(DstFopts opts, DstSlot *args) {
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return dst_v_count(args) == 1;
return janet_v_count(args) == 1;
}
static int minarity2(DstFopts opts, DstSlot *args) {
static int minarity2(JanetFopts opts, JanetSlot *args) {
(void) opts;
return dst_v_count(args) >= 2;
return janet_v_count(args) >= 2;
}
static int fixarity2(DstFopts opts, DstSlot *args) {
static int fixarity2(JanetFopts opts, JanetSlot *args) {
(void) opts;
return dst_v_count(args) == 2;
}static int fixarity3(DstFopts opts, DstSlot *args) {
return janet_v_count(args) == 2;
}static int fixarity3(JanetFopts opts, JanetSlot *args) {
(void) opts;
return dst_v_count(args) == 3;
return janet_v_count(args) == 3;
}
/* Generic hanldling for $A = op $B */
static DstSlot genericSS(DstFopts opts, int op, DstSlot s) {
DstSlot target = dstc_gettarget(opts);
dstc_emit_ss(opts.compiler, op, target, s, 1);
static JanetSlot genericSS(JanetFopts opts, int op, JanetSlot s) {
JanetSlot target = janetc_gettarget(opts);
janetc_emit_ss(opts.compiler, op, target, s, 1);
return target;
}
/* Generic hanldling for $A = $B op I */
static DstSlot genericSSI(DstFopts opts, int op, DstSlot s, int32_t imm) {
DstSlot target = dstc_gettarget(opts);
dstc_emit_ssi(opts.compiler, op, target, s, imm, 1);
static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
JanetSlot target = janetc_gettarget(opts);
janetc_emit_ssi(opts.compiler, op, target, s, imm, 1);
return target;
}
/* Emit a series of instructions instead of a function call to a math op */
static DstSlot opreduce(
DstFopts opts,
DstSlot *args,
static JanetSlot opreduce(
JanetFopts opts,
JanetSlot *args,
int op,
Dst nullary) {
DstCompiler *c = opts.compiler;
Janet nullary) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
len = dst_v_count(args);
DstSlot t;
len = janet_v_count(args);
JanetSlot t;
if (len == 0) {
return dstc_cslot(nullary);
return janetc_cslot(nullary);
} else if (len == 1) {
t = dstc_gettarget(opts);
dstc_emit_sss(c, op, t, dstc_cslot(nullary), args[0], 1);
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
return t;
}
t = dstc_gettarget(opts);
dstc_emit_sss(c, op, t, args[0], args[1], 1);
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], args[1], 1);
for (i = 2; i < len; i++)
dstc_emit_sss(c, op, t, t, args[i], 1);
janetc_emit_sss(c, op, t, t, args[i], 1);
return t;
}
/* Function optimizers */
static DstSlot do_error(DstFopts opts, DstSlot *args) {
dstc_emit_s(opts.compiler, DOP_ERROR, args[0], 0);
return dstc_cslot(dst_wrap_nil());
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
return janetc_cslot(janet_wrap_nil());
}
static DstSlot do_debug(DstFopts opts, DstSlot *args) {
static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
(void)args;
dstc_emit(opts.compiler, DOP_SIGNAL | (2 << 24));
return dstc_cslot(dst_wrap_nil());
janetc_emit(opts.compiler, JOP_SIGNAL | (2 << 24));
return janetc_cslot(janet_wrap_nil());
}
static DstSlot do_get(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_GET, dst_wrap_nil());
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
}
static DstSlot do_put(DstFopts opts, DstSlot *args) {
dstc_emit_sss(opts.compiler, DOP_PUT, args[0], args[1], args[2], 0);
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
return args[0];
}
static DstSlot do_length(DstFopts opts, DstSlot *args) {
return genericSS(opts, DOP_LENGTH, args[0]);
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_LENGTH, args[0]);
}
static DstSlot do_yield(DstFopts opts, DstSlot *args) {
return genericSSI(opts, DOP_SIGNAL, args[0], 3);
static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
}
static DstSlot do_resume(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_RESUME, dst_wrap_nil());
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
}
static DstSlot do_apply(DstFopts opts, DstSlot *args) {
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Push phase */
DstCompiler *c = opts.compiler;
JanetCompiler *c = opts.compiler;
int32_t i;
for (i = 1; i < dst_v_count(args) - 3; i += 3)
dstc_emit_sss(c, DOP_PUSH_3, args[i], args[i+1], args[i+2], 0);
if (i == dst_v_count(args) - 3)
dstc_emit_ss(c, DOP_PUSH_2, args[i], args[i+1], 0);
else if (i == dst_v_count(args) - 2)
dstc_emit_s(c, DOP_PUSH, args[i], 0);
for (i = 1; i < janet_v_count(args) - 3; i += 3)
janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i+1], args[i+2], 0);
if (i == janet_v_count(args) - 3)
janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i+1], 0);
else if (i == janet_v_count(args) - 2)
janetc_emit_s(c, JOP_PUSH, args[i], 0);
/* Push array phase */
dstc_emit_s(c, DOP_PUSH_ARRAY, dst_v_last(args), 0);
janetc_emit_s(c, JOP_PUSH_ARRAY, janet_v_last(args), 0);
/* Call phase */
DstSlot target;
if (opts.flags & DST_FOPTS_TAIL) {
dstc_emit_s(c, DOP_TAILCALL, args[0], 0);
target = dstc_cslot(dst_wrap_nil());
target.flags |= DST_SLOT_RETURNED;
JanetSlot target;
if (opts.flags & JANET_FOPTS_TAIL) {
janetc_emit_s(c, JOP_TAILCALL, args[0], 0);
target = janetc_cslot(janet_wrap_nil());
target.flags |= JANET_SLOT_RETURNED;
} else {
target = dstc_gettarget(opts);
dstc_emit_ss(c, DOP_CALL, target, args[0], 1);
target = janetc_gettarget(opts);
janetc_emit_ss(c, JOP_CALL, target, args[0], 1);
}
return target;
}
/* Varidadic operators specialization */
static DstSlot do_add(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_ADD, dst_wrap_integer(0));
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
}
static DstSlot do_sub(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_SUBTRACT, dst_wrap_integer(0));
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
}
static DstSlot do_mul(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_MULTIPLY, dst_wrap_integer(1));
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
}
static DstSlot do_div(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_DIVIDE, dst_wrap_integer(1));
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
}
static DstSlot do_band(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_BAND, dst_wrap_integer(-1));
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
}
static DstSlot do_bor(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_BOR, dst_wrap_integer(0));
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
}
static DstSlot do_bxor(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_BXOR, dst_wrap_integer(0));
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
}
static DstSlot do_lshift(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_SHIFT_LEFT, dst_wrap_integer(1));
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
}
static DstSlot do_rshift(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_SHIFT_RIGHT, dst_wrap_integer(1));
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
}
static DstSlot do_rshiftu(DstFopts opts, DstSlot *args) {
return opreduce(opts, args, DOP_SHIFT_RIGHT, dst_wrap_integer(1));
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
}
static DstSlot do_bnot(DstFopts opts, DstSlot *args) {
return genericSS(opts, DOP_BNOT, args[0]);
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_BNOT, args[0]);
}
/* Specialization for comparators */
static DstSlot compreduce(
DstFopts opts,
DstSlot *args,
static JanetSlot compreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int invert) {
DstCompiler *c = opts.compiler;
JanetCompiler *c = opts.compiler;
int32_t i, len;
len = dst_v_count(args);
len = janet_v_count(args);
int32_t *labels = NULL;
DstSlot t;
JanetSlot t;
if (len < 2) {
return invert
? dstc_cslot(dst_wrap_false())
: dstc_cslot(dst_wrap_true());
? janetc_cslot(janet_wrap_false())
: janetc_cslot(janet_wrap_true());
}
t = dstc_gettarget(opts);
t = janetc_gettarget(opts);
for (i = 1; i < len; i++) {
dstc_emit_sss(c, op, t, args[i - 1], args[i], 1);
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
if (i != (len - 1)) {
int32_t label = dstc_emit_si(c, DOP_JUMP_IF_NOT, t, 0, 1);
dst_v_push(labels, label);
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
janet_v_push(labels, label);
}
}
int32_t end = dst_v_count(c->buffer);
int32_t end = janet_v_count(c->buffer);
if (invert) {
dstc_emit_si(c, DOP_JUMP_IF, t, 3, 0);
dstc_emit_s(c, DOP_LOAD_TRUE, t, 1);
dstc_emit(c, DOP_JUMP | (2 << 8));
dstc_emit_s(c, DOP_LOAD_FALSE, t, 1);
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
janetc_emit(c, JOP_JUMP | (2 << 8));
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
}
for (i = 0; i < dst_v_count(labels); i++) {
for (i = 0; i < janet_v_count(labels); i++) {
int32_t label = labels[i];
c->buffer[label] |= ((end - label) << 16);
}
dst_v_free(labels);
janet_v_free(labels);
return t;
}
static DstSlot do_order_gt(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_GREATER_THAN, 0);
static JanetSlot do_order_gt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN, 0);
}
static DstSlot do_order_lt(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_LESS_THAN, 0);
static JanetSlot do_order_lt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN, 0);
}
static DstSlot do_order_gte(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_LESS_THAN, 1);
static JanetSlot do_order_gte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN, 1);
}
static DstSlot do_order_lte(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_GREATER_THAN, 1);
static JanetSlot do_order_lte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN, 1);
}
static DstSlot do_order_eq(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_EQUALS, 0);
static JanetSlot do_order_eq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, 0);
}
static DstSlot do_order_neq(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_EQUALS, 1);
static JanetSlot do_order_neq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, 1);
}
static DstSlot do_gt(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_NUMERIC_GREATER_THAN, 0);
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN, 0);
}
static DstSlot do_lt(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_NUMERIC_LESS_THAN, 0);
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_LESS_THAN, 0);
}
static DstSlot do_gte(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_NUMERIC_GREATER_THAN_EQUAL, 0);
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN_EQUAL, 0);
}
static DstSlot do_lte(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_NUMERIC_LESS_THAN_EQUAL, 0);
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_LESS_THAN_EQUAL, 0);
}
static DstSlot do_eq(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_NUMERIC_EQUAL, 0);
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_EQUAL, 0);
}
static DstSlot do_neq(DstFopts opts, DstSlot *args) {
return compreduce(opts, args, DOP_NUMERIC_EQUAL, 1);
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_NUMERIC_EQUAL, 1);
}
/* Arranged by tag */
static const DstFunOptimizer optimizers[] = {
static const JanetFunOptimizer optimizers[] = {
{fixarity0, do_debug},
{fixarity1, do_error},
{minarity2, do_apply},
@ -282,8 +282,8 @@ static const DstFunOptimizer optimizers[] = {
{NULL, do_neq}
};
const DstFunOptimizer *dstc_funopt(uint32_t flags) {
uint32_t tag = flags & DST_FUNCDEF_FLAG_TAG;
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
uint32_t tag = flags & JANET_FUNCDEF_FLAG_TAG;
if (tag == 0)
return NULL;
uint32_t index = tag - 1;

584
src/core/compile.c
View File

@ -20,55 +20,55 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "compile.h"
#include "emit.h"
#include "vector.h"
DstFopts dstc_fopts_default(DstCompiler *c) {
DstFopts ret;
JanetFopts janetc_fopts_default(JanetCompiler *c) {
JanetFopts ret;
ret.compiler = c;
ret.flags = 0;
ret.hint = dstc_cslot(dst_wrap_nil());
ret.hint = janetc_cslot(janet_wrap_nil());
return ret;
}
/* Throw an error with a dst string. */
void dstc_error(DstCompiler *c, const uint8_t *m) {
/* Throw an error with a janet string. */
void janetc_error(JanetCompiler *c, const uint8_t *m) {
/* Don't override first error */
if (c->result.status == DST_COMPILE_ERROR) {
if (c->result.status == JANET_COMPILE_ERROR) {
return;
}
c->result.status = DST_COMPILE_ERROR;
c->result.status = JANET_COMPILE_ERROR;
c->result.error = m;
}
/* Throw an error with a message in a cstring */
void dstc_cerror(DstCompiler *c, const char *m) {
dstc_error(c, dst_cstring(m));
void janetc_cerror(JanetCompiler *c, const char *m) {
janetc_error(c, janet_cstring(m));
}
/* Free a slot */
void dstc_freeslot(DstCompiler *c, DstSlot s) {
if (s.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF | DST_SLOT_NAMED)) return;
void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
if (s.envindex >= 0) return;
dstc_regalloc_free(&c->scope->ra, s.index);
janetc_regalloc_free(&c->scope->ra, s.index);
}
/* Add a slot to a scope with a symbol associated with it (def or var). */
void dstc_nameslot(DstCompiler *c, const uint8_t *sym, DstSlot s) {
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
SymPair sp;
sp.sym = sym;
sp.slot = s;
sp.keep = 0;
sp.slot.flags |= DST_SLOT_NAMED;
dst_v_push(c->scope->syms, sp);
sp.slot.flags |= JANET_SLOT_NAMED;
janet_v_push(c->scope->syms, sp);
}
/* Create a slot with a constant */
DstSlot dstc_cslot(Dst x) {
DstSlot ret;
ret.flags = (1 << dst_type(x)) | DST_SLOT_CONSTANT;
JanetSlot janetc_cslot(Janet x) {
JanetSlot ret;
ret.flags = (1 << janet_type(x)) | JANET_SLOT_CONSTANT;
ret.index = -1;
ret.constant = x;
ret.envindex = -1;
@ -76,18 +76,18 @@ DstSlot dstc_cslot(Dst x) {
}
/* Get a local slot */
DstSlot dstc_farslot(DstCompiler *c) {
DstSlot ret;
ret.flags = DST_SLOTTYPE_ANY;
ret.index = dstc_allocfar(c);
ret.constant = dst_wrap_nil();
JanetSlot janetc_farslot(JanetCompiler *c) {
JanetSlot ret;
ret.flags = JANET_SLOTTYPE_ANY;
ret.index = janetc_allocfar(c);
ret.constant = janet_wrap_nil();
ret.envindex = -1;
return ret;
}
/* Enter a new scope */
void dstc_scope(DstScope *s, DstCompiler *c, int flags, const char *name) {
DstScope scope;
void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name) {
JanetScope scope;
scope.name = name;
scope.child = NULL;
scope.consts = NULL;
@ -95,14 +95,14 @@ void dstc_scope(DstScope *s, DstCompiler *c, int flags, const char *name) {
scope.envs = NULL;
scope.defs = NULL;
scope.selfconst = -1;
scope.bytecode_start = dst_v_count(c->buffer);
scope.bytecode_start = janet_v_count(c->buffer);
scope.flags = flags;
*s = scope;
/* Inherit slots */
if ((!(flags & DST_SCOPE_FUNCTION)) && c->scope) {
dstc_regalloc_clone(&s->ra, &(c->scope->ra));
if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) {
janetc_regalloc_clone(&s->ra, &(c->scope->ra));
} else {
dstc_regalloc_init(&s->ra);
janetc_regalloc_init(&s->ra);
}
/* Link parent and child and update pointer */
s->parent = c->scope;
@ -112,39 +112,39 @@ void dstc_scope(DstScope *s, DstCompiler *c, int flags, const char *name) {
}
/* Leave a scope. */
void dstc_popscope(DstCompiler *c) {
DstScope *oldscope = c->scope;
DstScope *newscope = oldscope->parent;
void janetc_popscope(JanetCompiler *c) {
JanetScope *oldscope = c->scope;
JanetScope *newscope = oldscope->parent;
/* Move free slots to parent scope if not a new function.
* We need to know the total number of slots used when compiling the function. */
if (!(oldscope->flags & (DST_SCOPE_FUNCTION | DST_SCOPE_UNUSED)) && newscope) {
if (!(oldscope->flags & (JANET_SCOPE_FUNCTION | JANET_SCOPE_UNUSED)) && newscope) {
/* Parent scopes inherit child's closure flag. Needed
* for while loops. (if a while loop creates a closure, it
* is compiled to a tail recursive iife) */
if (oldscope->flags & DST_SCOPE_CLOSURE) {
newscope->flags |= DST_SCOPE_CLOSURE;
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
newscope->flags |= JANET_SCOPE_CLOSURE;
}
if (newscope->ra.max < oldscope->ra.max)
newscope->ra.max = oldscope->ra.max;
/* Keep upvalue slots */
for (int32_t i = 0; i < dst_v_count(oldscope->syms); i++) {
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
SymPair pair = oldscope->syms[i];
if (pair.keep) {
/* The variable should not be lexically accessible */
pair.sym = NULL;
dst_v_push(newscope->syms, pair);
dstc_regalloc_touch(&newscope->ra, pair.slot.index);
janet_v_push(newscope->syms, pair);
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
}
}
}
/* Free the old scope */
dst_v_free(oldscope->consts);
dst_v_free(oldscope->syms);
dst_v_free(oldscope->envs);
dst_v_free(oldscope->defs);
dstc_regalloc_deinit(&oldscope->ra);
janet_v_free(oldscope->consts);
janet_v_free(oldscope->syms);
janet_v_free(oldscope->envs);
janet_v_free(oldscope->defs);
janetc_regalloc_deinit(&oldscope->ra);
/* Update pointer */
if (newscope)
newscope->child = NULL;
@ -152,22 +152,22 @@ void dstc_popscope(DstCompiler *c) {
}
/* Leave a scope but keep a slot allocated. */
void dstc_popscope_keepslot(DstCompiler *c, DstSlot retslot) {
DstScope *scope;
dstc_popscope(c);
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
JanetScope *scope;
janetc_popscope(c);
scope = c->scope;
if (scope && retslot.envindex < 0 && retslot.index >= 0) {
dstc_regalloc_touch(&scope->ra, retslot.index);
janetc_regalloc_touch(&scope->ra, retslot.index);
}
}
/* Allow searching for symbols. Return information about the symbol */
DstSlot dstc_resolve(
DstCompiler *c,
JanetSlot janetc_resolve(
JanetCompiler *c,
const uint8_t *sym) {
DstSlot ret = dstc_cslot(dst_wrap_nil());
DstScope *scope = c->scope;
JanetSlot ret = janetc_cslot(janet_wrap_nil());
JanetScope *scope = c->scope;
SymPair *pair;
int foundlocal = 1;
int unused = 0;
@ -175,9 +175,9 @@ DstSlot dstc_resolve(
/* Search scopes for symbol, starting from top */
while (scope) {
int32_t i, len;
if (scope->flags & DST_SCOPE_UNUSED)
if (scope->flags & JANET_SCOPE_UNUSED)
unused = 1;
len = dst_v_count(scope->syms);
len = janet_v_count(scope->syms);
/* Search in reverse order */
for (i = len - 1; i >= 0; i--) {
pair = scope->syms + i;
@ -186,29 +186,29 @@ DstSlot dstc_resolve(
goto found;
}
}
if (scope->flags & DST_SCOPE_FUNCTION)
if (scope->flags & JANET_SCOPE_FUNCTION)
foundlocal = 0;
scope = scope->parent;
}
/* Symbol not found - check for global */
{
Dst check;
DstBindingType btype = dst_resolve(c->env, sym, &check);
Janet check;
JanetBindingType btype = janet_resolve(c->env, sym, &check);
switch (btype) {
default:
case DST_BINDING_NONE:
dstc_error(c, dst_formatc("unknown symbol %q", sym));
return dstc_cslot(dst_wrap_nil());
case DST_BINDING_DEF:
case DST_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
return dstc_cslot(check);
case DST_BINDING_VAR:
case JANET_BINDING_NONE:
janetc_error(c, janet_formatc("unknown symbol %q", sym));
return janetc_cslot(janet_wrap_nil());
case JANET_BINDING_DEF:
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
return janetc_cslot(check);
case JANET_BINDING_VAR:
{
DstSlot ret = dstc_cslot(check);
JanetSlot ret = janetc_cslot(check);
/* TODO save type info */
ret.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE | DST_SLOTTYPE_ANY;
ret.flags &= ~DST_SLOT_CONSTANT;
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
ret.flags &= ~JANET_SLOT_CONSTANT;
return ret;
}
}
@ -218,7 +218,7 @@ DstSlot dstc_resolve(
found:
/* Constants can be returned immediately (they are stateless) */
if (ret.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF))
if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF))
return ret;
/* Unused references and locals shouldn't add captured envs. */
@ -229,20 +229,20 @@ DstSlot dstc_resolve(
/* non-local scope needs to expose its environment */
pair->keep = 1;
while (scope && !(scope->flags & DST_SCOPE_FUNCTION))
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
scope = scope->parent;
dst_assert(scope, "invalid scopes");
scope->flags |= DST_SCOPE_ENV;
janet_assert(scope, "invalid scopes");
scope->flags |= JANET_SCOPE_ENV;
scope = scope->child;
/* Propogate env up to current scope */
int32_t envindex = -1;
while (scope) {
if (scope->flags & DST_SCOPE_FUNCTION) {
if (scope->flags & JANET_SCOPE_FUNCTION) {
int32_t j, len;
int scopefound = 0;
/* Check if scope already has env. If so, break */
len = dst_v_count(scope->envs);
len = janet_v_count(scope->envs);
for (j = 0; j < len; j++) {
if (scope->envs[j] == envindex) {
scopefound = 1;
@ -252,8 +252,8 @@ DstSlot dstc_resolve(
}
/* Add the environment if it is not already referenced */
if (!scopefound) {
len = dst_v_count(scope->envs);
dst_v_push(scope->envs, envindex);
len = janet_v_count(scope->envs);
janet_v_push(scope->envs, envindex);
envindex = len;
}
}
@ -265,217 +265,217 @@ DstSlot dstc_resolve(
}
/* Generate the return instruction for a slot. */
DstSlot dstc_return(DstCompiler *c, DstSlot s) {
if (!(s.flags & DST_SLOT_RETURNED)) {
if (s.flags & DST_SLOT_CONSTANT && dst_checktype(s.constant, DST_NIL))
dstc_emit(c, DOP_RETURN_NIL);
JanetSlot janetc_return(JanetCompiler *c, JanetSlot s) {
if (!(s.flags & JANET_SLOT_RETURNED)) {
if (s.flags & JANET_SLOT_CONSTANT && janet_checktype(s.constant, JANET_NIL))
janetc_emit(c, JOP_RETURN_NIL);
else
dstc_emit_s(c, DOP_RETURN, s, 0);
s.flags |= DST_SLOT_RETURNED;
janetc_emit_s(c, JOP_RETURN, s, 0);
s.flags |= JANET_SLOT_RETURNED;
}
return s;
}
/* Get a target slot for emitting an instruction. */
DstSlot dstc_gettarget(DstFopts opts) {
DstSlot slot;
if ((opts.flags & DST_FOPTS_HINT) &&
JanetSlot janetc_gettarget(JanetFopts opts) {
JanetSlot slot;
if ((opts.flags & JANET_FOPTS_HINT) &&
(opts.hint.envindex < 0) &&
(opts.hint.index >= 0 && opts.hint.index <= 0xFF)) {
slot = opts.hint;
} else {
slot.envindex = -1;
slot.constant = dst_wrap_nil();
slot.constant = janet_wrap_nil();
slot.flags = 0;
slot.index = dstc_allocfar(opts.compiler);
slot.index = janetc_allocfar(opts.compiler);
}
return slot;
}
/* Get a bunch of slots for function arguments */
DstSlot *dstc_toslots(DstCompiler *c, const Dst *vals, int32_t len) {
JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
int32_t i;
DstSlot *ret = NULL;
DstFopts subopts = dstc_fopts_default(c);
JanetSlot *ret = NULL;
JanetFopts subopts = janetc_fopts_default(c);
for (i = 0; i < len; i++) {
dst_v_push(ret, dstc_value(subopts, vals[i]));
janet_v_push(ret, janetc_value(subopts, vals[i]));
}
return ret;
}
/* Get a bunch of slots for function arguments */
DstSlot *dstc_toslotskv(DstCompiler *c, Dst ds) {
DstSlot *ret = NULL;
DstFopts subopts = dstc_fopts_default(c);
const DstKV *kvs = NULL;
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
JanetSlot *ret = NULL;
JanetFopts subopts = janetc_fopts_default(c);
const JanetKV *kvs = NULL;
int32_t cap, i, len;
dst_dictionary_view(ds, &kvs, &len, &cap);
janet_dictionary_view(ds, &kvs, &len, &cap);
for (i = 0; i < cap; i++) {
if (dst_checktype(kvs[i].key, DST_NIL)) continue;
dst_v_push(ret, dstc_value(subopts, kvs[i].key));
dst_v_push(ret, dstc_value(subopts, kvs[i].value));
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
}
return ret;
}
/* Push slots load via dstc_toslots. */
void dstc_pushslots(DstCompiler *c, DstSlot *slots) {
/* Push slots load via janetc_toslots. */
void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
int32_t i;
for (i = 0; i < dst_v_count(slots) - 2; i += 3)
dstc_emit_sss(c, DOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0);
if (i == dst_v_count(slots) - 2)
dstc_emit_ss(c, DOP_PUSH_2, slots[i], slots[i+1], 0);
else if (i == dst_v_count(slots) - 1)
dstc_emit_s(c, DOP_PUSH, slots[i], 0);
for (i = 0; i < janet_v_count(slots) - 2; i += 3)
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0);
if (i == janet_v_count(slots) - 2)
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
else if (i == janet_v_count(slots) - 1)
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
}
/* Free slots loaded via dstc_toslots */
void dstc_freeslots(DstCompiler *c, DstSlot *slots) {
/* Free slots loaded via janetc_toslots */
void janetc_freeslots(JanetCompiler *c, JanetSlot *slots) {
int32_t i;
for (i = 0; i < dst_v_count(slots); i++) {
dstc_freeslot(c, slots[i]);
for (i = 0; i < janet_v_count(slots); i++) {
janetc_freeslot(c, slots[i]);
}
dst_v_free(slots);
janet_v_free(slots);
}
/* Compile some code that will be thrown away. Used to ensure
* that dead code is well formed without including it in the final
* bytecode. */
void dstc_throwaway(DstFopts opts, Dst x) {
DstCompiler *c = opts.compiler;
DstScope unusedScope;
int32_t bufstart = dst_v_count(c->buffer);
int32_t mapbufstart = dst_v_count(c->mapbuffer);
dstc_scope(&unusedScope, c, DST_SCOPE_UNUSED, "unusued");
dstc_value(opts, x);
dstc_popscope(c);
void janetc_throwaway(JanetFopts opts, Janet x) {
JanetCompiler *c = opts.compiler;
JanetScope unusedScope;
int32_t bufstart = janet_v_count(c->buffer);
int32_t mapbufstart = janet_v_count(c->mapbuffer);
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
janetc_value(opts, x);
janetc_popscope(c);
if (c->buffer) {
dst_v__cnt(c->buffer) = bufstart;
janet_v__cnt(c->buffer) = bufstart;
if (c->mapbuffer)
dst_v__cnt(c->mapbuffer) = mapbufstart;
janet_v__cnt(c->mapbuffer) = mapbufstart;
}
}
/* Compile a call or tailcall instruction */
static DstSlot dstc_call(DstFopts opts, DstSlot *slots, DstSlot fun) {
DstSlot retslot;
DstCompiler *c = opts.compiler;
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
JanetSlot retslot;
JanetCompiler *c = opts.compiler;
int specialized = 0;
if (fun.flags & DST_SLOT_CONSTANT) {
if (dst_checktype(fun.constant, DST_FUNCTION)) {
DstFunction *f = dst_unwrap_function(fun.constant);
const DstFunOptimizer *o = dstc_funopt(f->def->flags);
if (fun.flags & JANET_SLOT_CONSTANT) {
if (janet_checktype(fun.constant, JANET_FUNCTION)) {
JanetFunction *f = janet_unwrap_function(fun.constant);
const JanetFunOptimizer *o = janetc_funopt(f->def->flags);
if (o && (!o->can_optimize || o->can_optimize(opts, slots))) {
specialized = 1;
retslot = o->optimize(opts, slots);
}
}
/* TODO dst function inlining (no c functions)*/
/* TODO janet function inlining (no c functions)*/
}
if (!specialized) {
dstc_pushslots(c, slots);
if (opts.flags & DST_FOPTS_TAIL) {
dstc_emit_s(c, DOP_TAILCALL, fun, 0);
retslot = dstc_cslot(dst_wrap_nil());
retslot.flags = DST_SLOT_RETURNED;
janetc_pushslots(c, slots);
if (opts.flags & JANET_FOPTS_TAIL) {
janetc_emit_s(c, JOP_TAILCALL, fun, 0);
retslot = janetc_cslot(janet_wrap_nil());
retslot.flags = JANET_SLOT_RETURNED;
} else {
retslot = dstc_gettarget(opts);
dstc_emit_ss(c, DOP_CALL, retslot, fun, 1);
retslot = janetc_gettarget(opts);
janetc_emit_ss(c, JOP_CALL, retslot, fun, 1);
}
}
dstc_freeslots(c, slots);
janetc_freeslots(c, slots);
return retslot;
}
static DstSlot dstc_maker(DstFopts opts, DstSlot *slots, int op) {
DstCompiler *c = opts.compiler;
DstSlot retslot;
dstc_pushslots(c, slots);
dstc_freeslots(c, slots);
retslot = dstc_gettarget(opts);
dstc_emit_s(c, op, retslot, 1);
static JanetSlot janetc_maker(JanetFopts opts, JanetSlot *slots, int op) {
JanetCompiler *c = opts.compiler;
JanetSlot retslot;
janetc_pushslots(c, slots);
janetc_freeslots(c, slots);
retslot = janetc_gettarget(opts);
janetc_emit_s(c, op, retslot, 1);
return retslot;
}
static DstSlot dstc_array(DstFopts opts, Dst x) {
DstCompiler *c = opts.compiler;
DstArray *a = dst_unwrap_array(x);
return dstc_maker(opts,
dstc_toslots(c, a->data, a->count),
DOP_MAKE_ARRAY);
static JanetSlot janetc_array(JanetFopts opts, Janet x) {
JanetCompiler *c = opts.compiler;
JanetArray *a = janet_unwrap_array(x);
return janetc_maker(opts,
janetc_toslots(c, a->data, a->count),
JOP_MAKE_ARRAY);
}
static DstSlot dstc_tablector(DstFopts opts, Dst x, int op) {
DstCompiler *c = opts.compiler;
return dstc_maker(opts,
dstc_toslotskv(c, x),
static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) {
JanetCompiler *c = opts.compiler;
return janetc_maker(opts,
janetc_toslotskv(c, x),
op);
}
static DstSlot dstc_bufferctor(DstFopts opts, Dst x) {
DstCompiler *c = opts.compiler;
DstBuffer *b = dst_unwrap_buffer(x);
Dst onearg = dst_stringv(b->data, b->count);
return dstc_maker(opts,
dstc_toslots(c, &onearg, 1),
DOP_MAKE_BUFFER);
static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) {
JanetCompiler *c = opts.compiler;
JanetBuffer *b = janet_unwrap_buffer(x);
Janet onearg = janet_stringv(b->data, b->count);
return janetc_maker(opts,
janetc_toslots(c, &onearg, 1),
JOP_MAKE_BUFFER);
}
static DstSlot dstc_symbol(DstFopts opts, const uint8_t *sym) {
if (dst_string_length(sym) && sym[0] != ':') {
return dstc_resolve(opts.compiler, sym);
static JanetSlot janetc_symbol(JanetFopts opts, const uint8_t *sym) {
if (janet_string_length(sym) && sym[0] != ':') {
return janetc_resolve(opts.compiler, sym);
} else {
return dstc_cslot(dst_wrap_symbol(sym));
return janetc_cslot(janet_wrap_symbol(sym));
}
}
/* Expand a macro one time. Also get the special form compiler if we
* find that instead. */
static int macroexpand1(
DstCompiler *c,
Dst x,
Dst *out,
const DstSpecial **spec) {
if (!dst_checktype(x, DST_TUPLE))
JanetCompiler *c,
Janet x,
Janet *out,
const JanetSpecial **spec) {
if (!janet_checktype(x, JANET_TUPLE))
return 0;
const Dst *form = dst_unwrap_tuple(x);
if (dst_tuple_length(form) == 0)
const Janet *form = janet_unwrap_tuple(x);
if (janet_tuple_length(form) == 0)
return 0;
/* Source map - only set when we get a tuple */
if (dst_tuple_sm_line(form) > 0) {
c->current_mapping.line = dst_tuple_sm_line(form);
c->current_mapping.column = dst_tuple_sm_col(form);
if (janet_tuple_sm_line(form) > 0) {
c->current_mapping.line = janet_tuple_sm_line(form);
c->current_mapping.column = janet_tuple_sm_col(form);
}
if (!dst_checktype(form[0], DST_SYMBOL))
if (!janet_checktype(form[0], JANET_SYMBOL))
return 0;
const uint8_t *name = dst_unwrap_symbol(form[0]);
const DstSpecial *s = dstc_special(name);
const uint8_t *name = janet_unwrap_symbol(form[0]);
const JanetSpecial *s = janetc_special(name);
if (s) {
*spec = s;
return 0;
}
Dst macroval;
DstBindingType btype = dst_resolve(c->env, name, &macroval);
if (btype != DST_BINDING_MACRO ||
!dst_checktype(macroval, DST_FUNCTION))
Janet macroval;
JanetBindingType btype = janet_resolve(c->env, name, &macroval);
if (btype != JANET_BINDING_MACRO ||
!janet_checktype(macroval, JANET_FUNCTION))
return 0;
/* Evaluate macro */
DstFiber *fiberp;
DstFunction *macro = dst_unwrap_function(macroval);
int lock = dst_gclock();
DstSignal status = dst_call(
JanetFiber *fiberp;
JanetFunction *macro = janet_unwrap_function(macroval);
int lock = janet_gclock();
JanetSignal status = janet_call(
macro,
dst_tuple_length(form) - 1,
janet_tuple_length(form) - 1,
form + 1,
&x,
&fiberp);
dst_gcunlock(lock);
if (status != DST_SIGNAL_OK) {
const uint8_t *es = dst_formatc("(macro) %V", x);
janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) {
const uint8_t *es = janet_formatc("(macro) %V", x);
c->result.macrofiber = fiberp;
dstc_error(c, es);
janetc_error(c, es);
} else {
*out = x;
}
@ -484,81 +484,81 @@ static int macroexpand1(
}
/* Compile a single value */
DstSlot dstc_value(DstFopts opts, Dst x) {
DstSlot ret;
DstCompiler *c = opts.compiler;
DstSourceMapping last_mapping = c->current_mapping;
JanetSlot janetc_value(JanetFopts opts, Janet x) {
JanetSlot ret;
JanetCompiler *c = opts.compiler;
JanetSourceMapping last_mapping = c->current_mapping;
c->recursion_guard--;
/* Guard against previous errors and unbounded recursion */
if (c->result.status == DST_COMPILE_ERROR) return dstc_cslot(dst_wrap_nil());
if (c->result.status == JANET_COMPILE_ERROR) return janetc_cslot(janet_wrap_nil());
if (c->recursion_guard <= 0) {
dstc_cerror(c, "recursed too deeply");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(c, "recursed too deeply");
return janetc_cslot(janet_wrap_nil());
}
/* Macro expand. Also gets possible special form and
* refines source mapping cursor if possible. */
const DstSpecial *spec = NULL;
int macroi = DST_MAX_MACRO_EXPAND;
const JanetSpecial *spec = NULL;
int macroi = JANET_MAX_MACRO_EXPAND;
while (macroi &&
c->result.status != DST_COMPILE_ERROR &&
c->result.status != JANET_COMPILE_ERROR &&
macroexpand1(c, x, &x, &spec))
macroi--;
if (macroi == 0) {
dstc_cerror(c, "recursed too deeply in macro expansion");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(c, "recursed too deeply in macro expansion");
return janetc_cslot(janet_wrap_nil());
}
/* Special forms */
if (spec) {
const Dst *tup = dst_unwrap_tuple(x);
ret = spec->compile(opts, dst_tuple_length(tup) - 1, tup + 1);
const Janet *tup = janet_unwrap_tuple(x);
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
} else {
switch (dst_type(x)) {
case DST_TUPLE:
switch (janet_type(x)) {
case JANET_TUPLE:
{
DstFopts subopts = dstc_fopts_default(c);
const Dst *tup = dst_unwrap_tuple(x);
JanetFopts subopts = janetc_fopts_default(c);
const Janet *tup = janet_unwrap_tuple(x);
/* Empty tuple is tuple literal */
if (dst_tuple_length(tup) == 0) {
ret = dstc_cslot(x);
if (janet_tuple_length(tup) == 0) {
ret = janetc_cslot(x);
} else {
DstSlot head = dstc_value(subopts, tup[0]);
subopts.flags = DST_FUNCTION | DST_CFUNCTION;
ret = dstc_call(opts, dstc_toslots(c, tup + 1, dst_tuple_length(tup) - 1), head);
dstc_freeslot(c, head);
JanetSlot head = janetc_value(subopts, tup[0]);
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
janetc_freeslot(c, head);
}
}
break;
case DST_SYMBOL:
ret = dstc_symbol(opts, dst_unwrap_symbol(x));
case JANET_SYMBOL:
ret = janetc_symbol(opts, janet_unwrap_symbol(x));
break;
case DST_ARRAY:
ret = dstc_array(opts, x);
case JANET_ARRAY:
ret = janetc_array(opts, x);
break;
case DST_STRUCT:
ret = dstc_tablector(opts, x, DOP_MAKE_STRUCT);
case JANET_STRUCT:
ret = janetc_tablector(opts, x, JOP_MAKE_STRUCT);
break;
case DST_TABLE:
ret = dstc_tablector(opts, x, DOP_MAKE_TABLE);
case JANET_TABLE:
ret = janetc_tablector(opts, x, JOP_MAKE_TABLE);
break;
case DST_BUFFER:
ret = dstc_bufferctor(opts, x);
case JANET_BUFFER:
ret = janetc_bufferctor(opts, x);
break;
default:
ret = dstc_cslot(x);
ret = janetc_cslot(x);
break;
}
}
if (c->result.status == DST_COMPILE_ERROR)
return dstc_cslot(dst_wrap_nil());
if (c->result.status == JANET_COMPILE_ERROR)
return janetc_cslot(janet_wrap_nil());
c->current_mapping = last_mapping;
if (opts.flags & DST_FOPTS_TAIL)
ret = dstc_return(opts.compiler, ret);
if (opts.flags & DST_FOPTS_HINT) {
dstc_copy(opts.compiler, opts.hint, ret);
if (opts.flags & JANET_FOPTS_TAIL)
ret = janetc_return(opts.compiler, ret);
if (opts.flags & JANET_FOPTS_HINT) {
janetc_copy(opts.compiler, opts.hint, ret);
ret = opts.hint;
}
opts.compiler->recursion_guard++;
@ -566,41 +566,41 @@ DstSlot dstc_value(DstFopts opts, Dst x) {
}
/* Compile a funcdef */
DstFuncDef *dstc_pop_funcdef(DstCompiler *c) {
DstScope *scope = c->scope;
DstFuncDef *def = dst_funcdef_alloc();
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
JanetScope *scope = c->scope;
JanetFuncDef *def = janet_funcdef_alloc();
def->slotcount = scope->ra.max + 1;
dst_assert(scope->flags & DST_SCOPE_FUNCTION, "expected function scope");
janet_assert(scope->flags & JANET_SCOPE_FUNCTION, "expected function scope");
/* Copy envs */
def->environments_length = dst_v_count(scope->envs);
def->environments = dst_v_flatten(scope->envs);
def->environments_length = janet_v_count(scope->envs);
def->environments = janet_v_flatten(scope->envs);
def->constants_length = dst_v_count(scope->consts);
def->constants = dst_v_flatten(scope->consts);
def->constants_length = janet_v_count(scope->consts);
def->constants = janet_v_flatten(scope->consts);
def->defs_length = dst_v_count(scope->defs);
def->defs = dst_v_flatten(scope->defs);
def->defs_length = janet_v_count(scope->defs);
def->defs = janet_v_flatten(scope->defs);
/* Copy bytecode (only last chunk) */
def->bytecode_length = dst_v_count(c->buffer) - scope->bytecode_start;
def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
if (def->bytecode_length) {
size_t s = sizeof(int32_t) * def->bytecode_length;
def->bytecode = malloc(s);
if (NULL == def->bytecode) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
dst_v__cnt(c->buffer) = scope->bytecode_start;
janet_v__cnt(c->buffer) = scope->bytecode_start;
if (NULL != c->mapbuffer) {
size_t s = sizeof(DstSourceMapping) * def->bytecode_length;
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
def->sourcemap = malloc(s);
if (NULL == def->sourcemap) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
dst_v__cnt(c->mapbuffer) = scope->bytecode_start;
janet_v__cnt(c->mapbuffer) = scope->bytecode_start;
}
}
@ -609,29 +609,29 @@ DstFuncDef *dstc_pop_funcdef(DstCompiler *c) {
def->arity = 0;
def->flags = 0;
if (scope->flags & DST_SCOPE_ENV) {
def->flags |= DST_FUNCDEF_FLAG_NEEDSENV;
if (scope->flags & JANET_SCOPE_ENV) {
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
}
/* Pop the scope */
dstc_popscope(c);
janetc_popscope(c);
return def;
}
/* Initialize a compiler */
static void dstc_init(DstCompiler *c, DstTable *env, const uint8_t *where) {
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
c->scope = NULL;
c->buffer = NULL;
c->mapbuffer = NULL;
c->recursion_guard = DST_RECURSION_GUARD;
c->recursion_guard = JANET_RECURSION_GUARD;
c->env = env;
c->source = where;
c->current_mapping.line = 0;
c->current_mapping.column = 0;
/* Init result */
c->result.error = NULL;
c->result.status = DST_COMPILE_OK;
c->result.status = JANET_COMPILE_OK;
c->result.funcdef = NULL;
c->result.macrofiber = NULL;
c->result.error_mapping.line = 0;
@ -639,79 +639,79 @@ static void dstc_init(DstCompiler *c, DstTable *env, const uint8_t *where) {
}
/* Deinitialize a compiler struct */
static void dstc_deinit(DstCompiler *c) {
dst_v_free(c->buffer);
dst_v_free(c->mapbuffer);
static void janetc_deinit(JanetCompiler *c) {
janet_v_free(c->buffer);
janet_v_free(c->mapbuffer);
c->env = NULL;
}
/* Compile a form. */
DstCompileResult dst_compile(Dst source, DstTable *env, const uint8_t *where) {
DstCompiler c;
DstScope rootscope;
DstFopts fopts;
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
JanetCompiler c;
JanetScope rootscope;
JanetFopts fopts;
dstc_init(&c, env, where);
janetc_init(&c, env, where);
/* Push a function scope */
dstc_scope(&rootscope, &c, DST_SCOPE_FUNCTION | DST_SCOPE_TOP, "root");
janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
/* Set initial form options */
fopts.compiler = &c;
fopts.flags = DST_FOPTS_TAIL | DST_SLOTTYPE_ANY;
fopts.hint = dstc_cslot(dst_wrap_nil());
fopts.flags = JANET_FOPTS_TAIL | JANET_SLOTTYPE_ANY;
fopts.hint = janetc_cslot(janet_wrap_nil());
/* Compile the value */
dstc_value(fopts, source);
janetc_value(fopts, source);
if (c.result.status == DST_COMPILE_OK) {
DstFuncDef *def = dstc_pop_funcdef(&c);
def->name = dst_cstring("_thunk");
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("_thunk");
c.result.funcdef = def;
} else {
c.result.error_mapping = c.current_mapping;
dstc_popscope(&c);
janetc_popscope(&c);
}
dstc_deinit(&c);
janetc_deinit(&c);
return c.result;
}
/* C Function for compiling */
static int cfun(DstArgs args) {
DstCompileResult res;
DstTable *t;
DstTable *env;
DST_MINARITY(args, 2);
DST_MAXARITY(args, 3);
DST_ARG_TABLE(env, args, 1);
static int cfun(JanetArgs args) {
JanetCompileResult res;
JanetTable *t;
JanetTable *env;
JANET_MINARITY(args, 2);
JANET_MAXARITY(args, 3);
JANET_ARG_TABLE(env, args, 1);
const uint8_t *source = NULL;
if (args.n == 3) {
DST_ARG_STRING(source, args, 2);
JANET_ARG_STRING(source, args, 2);
}
res = dst_compile(args.v[0], env, source);
if (res.status == DST_COMPILE_OK) {
DST_RETURN_FUNCTION(args, dst_thunk(res.funcdef));
res = janet_compile(args.v[0], env, source);
if (res.status == JANET_COMPILE_OK) {
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
} else {
t = dst_table(4);
dst_table_put(t, dst_csymbolv(":error"), dst_wrap_string(res.error));
dst_table_put(t, dst_csymbolv(":line"), dst_wrap_integer(res.error_mapping.line));
dst_table_put(t, dst_csymbolv(":column"), dst_wrap_integer(res.error_mapping.column));
t = janet_table(4);
janet_table_put(t, janet_csymbolv(":error"), janet_wrap_string(res.error));
janet_table_put(t, janet_csymbolv(":line"), janet_wrap_integer(res.error_mapping.line));
janet_table_put(t, janet_csymbolv(":column"), janet_wrap_integer(res.error_mapping.column));
if (res.macrofiber) {
dst_table_put(t, dst_csymbolv(":fiber"), dst_wrap_fiber(res.macrofiber));
janet_table_put(t, janet_csymbolv(":fiber"), janet_wrap_fiber(res.macrofiber));
}
DST_RETURN_TABLE(args, t);
JANET_RETURN_TABLE(args, t);
}
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"compile", cfun},
{NULL, NULL}
};
int dst_lib_compile(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_compile(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

202
src/core/compile.h
View File

@ -20,106 +20,106 @@
* IN THE SOFTWARE.
*/
#ifndef DST_COMPILE_H
#define DST_COMPILE_H
#ifndef JANET_COMPILE_H
#define JANET_COMPILE_H
#include <dst/dst.h>
#include <janet/janet.h>
#include "regalloc.h"
/* Tags for some functions for the prepared inliner */
#define DST_FUN_DEBUG 1
#define DST_FUN_ERROR 2
#define DST_FUN_APPLY 3
#define DST_FUN_YIELD 4
#define DST_FUN_RESUME 5
#define DST_FUN_GET 6
#define DST_FUN_PUT 7
#define DST_FUN_LENGTH 8
#define DST_FUN_ADD 9
#define DST_FUN_SUBTRACT 10
#define DST_FUN_MULTIPLY 11
#define DST_FUN_DIVIDE 12
#define DST_FUN_BAND 13
#define DST_FUN_BOR 14
#define DST_FUN_BXOR 15
#define DST_FUN_LSHIFT 16
#define DST_FUN_RSHIFT 17
#define DST_FUN_RSHIFTU 18
#define DST_FUN_BNOT 19
#define DST_FUN_ORDER_GT 20
#define DST_FUN_ORDER_LT 21
#define DST_FUN_ORDER_GTE 22
#define DST_FUN_ORDER_LTE 23
#define DST_FUN_ORDER_EQ 24
#define DST_FUN_ORDER_NEQ 25
#define DST_FUN_GT 26
#define DST_FUN_LT 27
#define DST_FUN_GTE 28
#define DST_FUN_LTE 29
#define DST_FUN_EQ 30
#define DST_FUN_NEQ 31
#define JANET_FUN_DEBUG 1
#define JANET_FUN_ERROR 2
#define JANET_FUN_APPLY 3
#define JANET_FUN_YIELD 4
#define JANET_FUN_RESUME 5
#define JANET_FUN_GET 6
#define JANET_FUN_PUT 7
#define JANET_FUN_LENGTH 8
#define JANET_FUN_ADD 9
#define JANET_FUN_SUBTRACT 10
#define JANET_FUN_MULTIPLY 11
#define JANET_FUN_DIVIDE 12
#define JANET_FUN_BAND 13
#define JANET_FUN_BOR 14
#define JANET_FUN_BXOR 15
#define JANET_FUN_LSHIFT 16
#define JANET_FUN_RSHIFT 17
#define JANET_FUN_RSHIFTU 18
#define JANET_FUN_BNOT 19
#define JANET_FUN_ORDER_GT 20
#define JANET_FUN_ORDER_LT 21
#define JANET_FUN_ORDER_GTE 22
#define JANET_FUN_ORDER_LTE 23
#define JANET_FUN_ORDER_EQ 24
#define JANET_FUN_ORDER_NEQ 25
#define JANET_FUN_GT 26
#define JANET_FUN_LT 27
#define JANET_FUN_GTE 28
#define JANET_FUN_LTE 29
#define JANET_FUN_EQ 30
#define JANET_FUN_NEQ 31
/* Compiler typedefs */
typedef struct DstCompiler DstCompiler;
typedef struct JanetCompiler JanetCompiler;
typedef struct FormOptions FormOptions;
typedef struct SlotTracker SlotTracker;
typedef struct DstScope DstScope;
typedef struct DstSlot DstSlot;
typedef struct DstFopts DstFopts;
typedef struct DstFunOptimizer DstFunOptimizer;
typedef struct DstSpecial DstSpecial;
typedef struct JanetScope JanetScope;
typedef struct JanetSlot JanetSlot;
typedef struct JanetFopts JanetFopts;
typedef struct JanetFunOptimizer JanetFunOptimizer;
typedef struct JanetSpecial JanetSpecial;
#define DST_SLOT_CONSTANT 0x10000
#define DST_SLOT_NAMED 0x20000
#define DST_SLOT_MUTABLE 0x40000
#define DST_SLOT_REF 0x80000
#define DST_SLOT_RETURNED 0x100000
#define JANET_SLOT_CONSTANT 0x10000
#define JANET_SLOT_NAMED 0x20000
#define JANET_SLOT_MUTABLE 0x40000
#define JANET_SLOT_REF 0x80000
#define JANET_SLOT_RETURNED 0x100000
/* Needed for handling single element arrays as global vars. */
#define DST_SLOTTYPE_ANY 0xFFFF
#define JANET_SLOTTYPE_ANY 0xFFFF
/* A stack slot */
struct DstSlot {
Dst constant; /* If the slot has a constant value */
struct JanetSlot {
Janet constant; /* If the slot has a constant value */
int32_t index;
int32_t envindex; /* 0 is local, positive number is an upvalue */
uint32_t flags;
};
#define DST_SCOPE_FUNCTION 1
#define DST_SCOPE_ENV 2
#define DST_SCOPE_TOP 4
#define DST_SCOPE_UNUSED 8
#define DST_SCOPE_CLOSURE 16
#define JANET_SCOPE_FUNCTION 1
#define JANET_SCOPE_ENV 2
#define JANET_SCOPE_TOP 4
#define JANET_SCOPE_UNUSED 8
#define JANET_SCOPE_CLOSURE 16
/* A symbol and slot pair */
typedef struct SymPair {
DstSlot slot;
JanetSlot slot;
const uint8_t *sym;
int keep;
} SymPair;
/* A lexical scope during compilation */
struct DstScope {
struct JanetScope {
/* For debugging */
const char *name;
/* Scopes are doubly linked list */
DstScope *parent;
DstScope *child;
JanetScope *parent;
JanetScope *child;
/* Constants for this funcdef */
Dst *consts;
Janet *consts;
/* Map of symbols to slots. Use a simple linear scan for symbols. */
SymPair *syms;
/* FuncDefs */
DstFuncDef **defs;
JanetFuncDef **defs;
/* Regsiter allocator */
DstcRegisterAllocator ra;
JanetcRegisterAllocator ra;
/* Referenced closure environents. The values at each index correspond
* to which index to get the environment from in the parent. The environment
@ -134,107 +134,107 @@ struct DstScope {
};
/* Compilation state */
struct DstCompiler {
struct JanetCompiler {
/* Pointer to current scope */
DstScope *scope;
JanetScope *scope;
uint32_t *buffer;
DstSourceMapping *mapbuffer;
JanetSourceMapping *mapbuffer;
/* Hold the environment */
DstTable *env;
JanetTable *env;
/* Name of source to attach to generated functions */
const uint8_t *source;
/* The result of compilation */
DstCompileResult result;
JanetCompileResult result;
/* Keep track of where we are in the source */
DstSourceMapping current_mapping;
JanetSourceMapping current_mapping;
/* Prevent unbounded recursion */
int recursion_guard;
};
#define DST_FOPTS_TAIL 0x10000
#define DST_FOPTS_HINT 0x20000
#define DST_FOPTS_DROP 0x40000
#define JANET_FOPTS_TAIL 0x10000
#define JANET_FOPTS_HINT 0x20000
#define JANET_FOPTS_DROP 0x40000
/* Options for compiling a single form */
struct DstFopts {
DstCompiler *compiler;
DstSlot hint;
struct JanetFopts {
JanetCompiler *compiler;
JanetSlot hint;
uint32_t flags; /* bit set of accepted primitive types */
};
/* Get the default form options */
DstFopts dstc_fopts_default(DstCompiler *c);
JanetFopts janetc_fopts_default(JanetCompiler *c);
/* For optimizing builtin normal functions. */
struct DstFunOptimizer {
int (*can_optimize)(DstFopts opts, DstSlot *args);
DstSlot (*optimize)(DstFopts opts, DstSlot *args);
struct JanetFunOptimizer {
int (*can_optimize)(JanetFopts opts, JanetSlot *args);
JanetSlot (*optimize)(JanetFopts opts, JanetSlot *args);
};
/* A grouping of a named special and the corresponding compiler fragment */
struct DstSpecial {
struct JanetSpecial {
const char *name;
DstSlot (*compile)(DstFopts opts, int32_t argn, const Dst *argv);
JanetSlot (*compile)(JanetFopts opts, int32_t argn, const Janet *argv);
};
/****************************************************/
/* Get an optimizer if it exists, otherwise NULL */
const DstFunOptimizer *dstc_funopt(uint32_t flags);
const JanetFunOptimizer *janetc_funopt(uint32_t flags);
/* Get a special. Return NULL if none exists */
const DstSpecial *dstc_special(const uint8_t *name);
const JanetSpecial *janetc_special(const uint8_t *name);
void dstc_freeslot(DstCompiler *c, DstSlot s);
void dstc_nameslot(DstCompiler *c, const uint8_t *sym, DstSlot s);
DstSlot dstc_farslot(DstCompiler *c);
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */
void dstc_throwaway(DstFopts opts, Dst x);
void janetc_throwaway(JanetFopts opts, Janet x);
/* Get a target slot for emitting an instruction. Will always return
* a local slot. */
DstSlot dstc_gettarget(DstFopts opts);
JanetSlot janetc_gettarget(JanetFopts opts);
/* Get a bunch of slots for function arguments */
DstSlot *dstc_toslots(DstCompiler *c, const Dst *vals, int32_t len);
JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
/* Get a bunch of slots for function arguments */
DstSlot *dstc_toslotskv(DstCompiler *c, Dst ds);
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
/* Push slots load via dstc_toslots. */
void dstc_pushslots(DstCompiler *c, DstSlot *slots);
/* Push slots load via janetc_toslots. */
void janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
/* Free slots loaded via dstc_toslots */
void dstc_freeslots(DstCompiler *c, DstSlot *slots);
/* Free slots loaded via janetc_toslots */
void janetc_freeslots(JanetCompiler *c, JanetSlot *slots);
/* Generate the return instruction for a slot. */
DstSlot dstc_return(DstCompiler *c, DstSlot s);
JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
/* Store an error */
void dstc_error(DstCompiler *c, const uint8_t *m);
void dstc_cerror(DstCompiler *c, const char *m);
void janetc_error(JanetCompiler *c, const uint8_t *m);
void janetc_cerror(JanetCompiler *c, const char *m);
/* Dispatch to correct form compiler */
DstSlot dstc_value(DstFopts opts, Dst x);
JanetSlot janetc_value(JanetFopts opts, Janet x);
/* Push and pop from the scope stack */
void dstc_scope(DstScope *s, DstCompiler *c, int flags, const char *name);
void dstc_popscope(DstCompiler *c);
void dstc_popscope_keepslot(DstCompiler *c, DstSlot retslot);
DstFuncDef *dstc_pop_funcdef(DstCompiler *c);
void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name);
void janetc_popscope(JanetCompiler *c);
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destory slots */
DstSlot dstc_cslot(Dst x);
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */
DstSlot dstc_resolve(DstCompiler *c, const uint8_t *sym);
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
#endif

34
src/core/core.dst → src/core/core.janet
View File

@ -1,4 +1,4 @@
# The core dst library
# The core janet library
# Copyright 2018 (C) Calvin Rose
###
@ -1005,8 +1005,8 @@
newenv)
(defn run-context
"Run a context. This evaluates expressions of dst in an environment,
and is encapsulates the parsing, compilation, and evaluation of dst.
"Run a context. This evaluates expressions of janet in an environment,
and is encapsulates the parsing, compilation, and evaluation of janet.
env is the environment to evaluate the code in, chunks is a function
that returns strings or buffers of source code (from a repl, file,
network connection, etc. onvalue and onerr are callbacks that are
@ -1142,23 +1142,23 @@
returnval)
(do
(def syspath (or (os.getenv "DST_PATH") "/usr/local/lib/dst/"))
(def syspath (or (os.getenv "JANET_PATH") "/usr/local/lib/janet/"))
(defglobal 'module.paths
@["./?.dst"
"./?/init.dst"
"./dst_modules/?.dst"
"./dst_modules/?/init.dst"
(string syspath dst.version "/?.dst")
(string syspath dst.version "/?/init.dst")
(string syspath "/?.dst")
(string syspath "/?/init.dst")])
@["./?.janet"
"./?/init.janet"
"./janet_modules/?.janet"
"./janet_modules/?/init.janet"
(string syspath janet.version "/?.janet")
(string syspath janet.version "/?/init.janet")
(string syspath "/?.janet")
(string syspath "/?/init.janet")])
(defglobal 'module.native-paths
@["./?.so"
"./?/??.so"
"./dst_modules/?.so"
"./dst_modules/?/??.so"
(string syspath dst.version "/?.so")
(string syspath dst.version "/?/??.so")
"./janet_modules/?.so"
"./janet_modules/?/??.so"
(string syspath janet.version "/?.so")
(string syspath janet.version "/?/??.so")
(string syspath "/?.so")
(string syspath "/?/??.so")]))
@ -1224,7 +1224,7 @@
(def f (find-mod path))
(if f
(do
# Normal dst module
# Normal janet module
(defn chunks [buf _] (file.read f 1024 buf))
(run-context newenv chunks identity
(if exit-on-error

552
src/core/corelib.c
View File

@ -20,7 +20,7 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "compile.h"
#include "state.h"
#include "util.h"
@ -29,17 +29,17 @@
#include <generated/core.h>
/* Only include dynamic modules if enabled */
#ifdef DST_DYNAMIC_MODULES
#ifdef JANET_DYNAMIC_MODULES
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
#include <windows.h>
typedef HINSTANCE Clib;
#define load_clib(name) LoadLibrary((name))
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
#define error_clib() "could not load dynamic library"
#elif defined(DST_WEB)
#elif defined(JANET_WEB)
#include <emscripten.h>
/* TODO - figure out how loading modules will work in JS */
typedef int Clib;
@ -54,298 +54,298 @@ typedef void *Clib;
#define error_clib() dlerror()
#endif
DstCFunction dst_native(const char *name, const uint8_t **error) {
JanetCFunction janet_native(const char *name, const uint8_t **error) {
Clib lib = load_clib(name);
DstCFunction init;
JanetCFunction init;
if (!lib) {
*error = dst_cstring(error_clib());
*error = janet_cstring(error_clib());
return NULL;
}
init = (DstCFunction) symbol_clib(lib, "_dst_init");
init = (JanetCFunction) symbol_clib(lib, "_janet_init");
if (!init) {
*error = dst_cstring("could not find _dst_init symbol");
*error = janet_cstring("could not find _janet_init symbol");
return NULL;
}
return init;
}
static int dst_core_native(DstArgs args) {
DstCFunction init;
static int janet_core_native(JanetArgs args) {
JanetCFunction init;
const uint8_t *error = NULL;
const uint8_t *path = NULL;
DST_FIXARITY(args, 1);
DST_ARG_STRING(path, args, 0);
init = dst_native((const char *)path, &error);
JANET_FIXARITY(args, 1);
JANET_ARG_STRING(path, args, 0);
init = janet_native((const char *)path, &error);
if (!init) {
DST_THROWV(args, dst_wrap_string(error));
JANET_THROWV(args, janet_wrap_string(error));
}
DST_RETURN_CFUNCTION(args, init);
JANET_RETURN_CFUNCTION(args, init);
}
#endif
/* end DST_DYNAMIC_MODULES */
/* end JANET_DYNAMIC_MODULES */
static int dst_core_print(DstArgs args) {
static int janet_core_print(JanetArgs args) {
int32_t i;
for (i = 0; i < args.n; ++i) {
int32_t j, len;
const uint8_t *vstr = dst_to_string(args.v[i]);
len = dst_string_length(vstr);
const uint8_t *vstr = janet_to_string(args.v[i]);
len = janet_string_length(vstr);
for (j = 0; j < len; ++j) {
putc(vstr[j], stdout);
}
}
putc('\n', stdout);
DST_RETURN_NIL(args);
JANET_RETURN_NIL(args);
}
static int dst_core_describe(DstArgs args) {
static int janet_core_describe(JanetArgs args) {
int32_t i;
DstBuffer b;
dst_buffer_init(&b, 0);
JanetBuffer b;
janet_buffer_init(&b, 0);
for (i = 0; i < args.n; ++i) {
int32_t len;
const uint8_t *str = dst_description(args.v[i]);
len = dst_string_length(str);
dst_buffer_push_bytes(&b, str, len);
const uint8_t *str = janet_description(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
*args.ret = dst_stringv(b.data, b.count);
dst_buffer_deinit(&b);
*args.ret = janet_stringv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
static int dst_core_string(DstArgs args) {
static int janet_core_string(JanetArgs args) {
int32_t i;
DstBuffer b;
dst_buffer_init(&b, 0);
JanetBuffer b;
janet_buffer_init(&b, 0);
for (i = 0; i < args.n; ++i) {
int32_t len;
const uint8_t *str = dst_to_string(args.v[i]);
len = dst_string_length(str);
dst_buffer_push_bytes(&b, str, len);
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
*args.ret = dst_stringv(b.data, b.count);
dst_buffer_deinit(&b);
*args.ret = janet_stringv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
static int dst_core_symbol(DstArgs args) {
static int janet_core_symbol(JanetArgs args) {
int32_t i;
DstBuffer b;
dst_buffer_init(&b, 0);
JanetBuffer b;
janet_buffer_init(&b, 0);
for (i = 0; i < args.n; ++i) {
int32_t len;
const uint8_t *str = dst_to_string(args.v[i]);
len = dst_string_length(str);
dst_buffer_push_bytes(&b, str, len);
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(&b, str, len);
}
*args.ret = dst_symbolv(b.data, b.count);
dst_buffer_deinit(&b);
*args.ret = janet_symbolv(b.data, b.count);
janet_buffer_deinit(&b);
return 0;
}
static int dst_core_buffer(DstArgs args) {
static int janet_core_buffer(JanetArgs args) {
int32_t i;
DstBuffer *b = dst_buffer(0);
JanetBuffer *b = janet_buffer(0);
for (i = 0; i < args.n; ++i) {
int32_t len;
const uint8_t *str = dst_to_string(args.v[i]);
len = dst_string_length(str);
dst_buffer_push_bytes(b, str, len);
const uint8_t *str = janet_to_string(args.v[i]);
len = janet_string_length(str);
janet_buffer_push_bytes(b, str, len);
}
DST_RETURN_BUFFER(args, b);
JANET_RETURN_BUFFER(args, b);
}
static int dst_core_scannumber(DstArgs args) {
static int janet_core_scannumber(JanetArgs args) {
const uint8_t *data;
Dst x;
Janet x;
int32_t len;
DST_FIXARITY(args, 1);
DST_ARG_BYTES(data, len, args, 0);
x = dst_scan_number(data, len);
if (dst_checktype(x, DST_NIL)) {
DST_THROW(args, "error parsing number");
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
x = janet_scan_number(data, len);
if (janet_checktype(x, JANET_NIL)) {
JANET_THROW(args, "error parsing number");
}
DST_RETURN(args, x);
JANET_RETURN(args, x);
}
static int dst_core_scaninteger(DstArgs args) {
static int janet_core_scaninteger(JanetArgs args) {
const uint8_t *data;
int32_t len, ret;
int err = 0;
DST_FIXARITY(args, 1);
DST_ARG_BYTES(data, len, args, 0);
ret = dst_scan_integer(data, len, &err);
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
ret = janet_scan_integer(data, len, &err);
if (err) {
DST_THROW(args, "error parsing integer");
JANET_THROW(args, "error parsing integer");
}
DST_RETURN_INTEGER(args, ret);
JANET_RETURN_INTEGER(args, ret);
}
static int dst_core_scanreal(DstArgs args) {
static int janet_core_scanreal(JanetArgs args) {
const uint8_t *data;
int32_t len;
double ret;
int err = 0;
DST_FIXARITY(args, 1);
DST_ARG_BYTES(data, len, args, 0);
ret = dst_scan_real(data, len, &err);
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
ret = janet_scan_real(data, len, &err);
if (err) {
DST_THROW(args, "error parsing real");
JANET_THROW(args, "error parsing real");
}
DST_RETURN_REAL(args, ret);
JANET_RETURN_REAL(args, ret);
}
static int dst_core_tuple(DstArgs args) {
DST_RETURN_TUPLE(args, dst_tuple_n(args.v, args.n));
static int janet_core_tuple(JanetArgs args) {
JANET_RETURN_TUPLE(args, janet_tuple_n(args.v, args.n));
}
static int dst_core_array(DstArgs args) {
DstArray *array = dst_array(args.n);
static int janet_core_array(JanetArgs args) {
JanetArray *array = janet_array(args.n);
array->count = args.n;
memcpy(array->data, args.v, args.n * sizeof(Dst));
DST_RETURN_ARRAY(args, array);
memcpy(array->data, args.v, args.n * sizeof(Janet));
JANET_RETURN_ARRAY(args, array);
}
static int dst_core_table(DstArgs args) {
static int janet_core_table(JanetArgs args) {
int32_t i;
DstTable *table = dst_table(args.n >> 1);
JanetTable *table = janet_table(args.n >> 1);
if (args.n & 1)
DST_THROW(args, "expected even number of arguments");
JANET_THROW(args, "expected even number of arguments");
for (i = 0; i < args.n; i += 2) {
dst_table_put(table, args.v[i], args.v[i + 1]);
janet_table_put(table, args.v[i], args.v[i + 1]);
}
DST_RETURN_TABLE(args, table);
JANET_RETURN_TABLE(args, table);
}
static int dst_core_struct(DstArgs args) {
static int janet_core_struct(JanetArgs args) {
int32_t i;
DstKV *st = dst_struct_begin(args.n >> 1);
JanetKV *st = janet_struct_begin(args.n >> 1);
if (args.n & 1)
DST_THROW(args, "expected even number of arguments");
JANET_THROW(args, "expected even number of arguments");
for (i = 0; i < args.n; i += 2) {
dst_struct_put(st, args.v[i], args.v[i + 1]);
janet_struct_put(st, args.v[i], args.v[i + 1]);
}
DST_RETURN_STRUCT(args, dst_struct_end(st));
JANET_RETURN_STRUCT(args, janet_struct_end(st));
}
static int dst_core_gensym(DstArgs args) {
DST_FIXARITY(args, 0);
DST_RETURN_SYMBOL(args, dst_symbol_gen());
static int janet_core_gensym(JanetArgs args) {
JANET_FIXARITY(args, 0);
JANET_RETURN_SYMBOL(args, janet_symbol_gen());
}
static int dst_core_gccollect(DstArgs args) {
static int janet_core_gccollect(JanetArgs args) {
(void) args;
dst_collect();
janet_collect();
return 0;
}
static int dst_core_gcsetinterval(DstArgs args) {
static int janet_core_gcsetinterval(JanetArgs args) {
int32_t val;
DST_FIXARITY(args, 1);
DST_ARG_INTEGER(val, args, 0);
JANET_FIXARITY(args, 1);
JANET_ARG_INTEGER(val, args, 0);
if (val < 0)
DST_THROW(args, "expected non-negative integer");
dst_vm_gc_interval = val;
DST_RETURN_NIL(args);
JANET_THROW(args, "expected non-negative integer");
janet_vm_gc_interval = val;
JANET_RETURN_NIL(args);
}
static int dst_core_gcinterval(DstArgs args) {
DST_FIXARITY(args, 0);
DST_RETURN_INTEGER(args, dst_vm_gc_interval);
static int janet_core_gcinterval(JanetArgs args) {
JANET_FIXARITY(args, 0);
JANET_RETURN_INTEGER(args, janet_vm_gc_interval);
}
static int dst_core_type(DstArgs args) {
DST_FIXARITY(args, 1);
DstType t = dst_type(args.v[0]);
if (t == DST_ABSTRACT) {
DST_RETURN(args, dst_csymbolv(dst_abstract_type(dst_unwrap_abstract(args.v[0]))->name));
static int janet_core_type(JanetArgs args) {
JANET_FIXARITY(args, 1);
JanetType t = janet_type(args.v[0]);
if (t == JANET_ABSTRACT) {
JANET_RETURN(args, janet_csymbolv(janet_abstract_type(janet_unwrap_abstract(args.v[0]))->name));
} else {
DST_RETURN(args, dst_csymbolv(dst_type_names[t]));
JANET_RETURN(args, janet_csymbolv(janet_type_names[t]));
}
}
static int dst_core_next(DstArgs args) {
Dst ds;
const DstKV *kv;
DST_FIXARITY(args, 2);
DST_CHECKMANY(args, 0, DST_TFLAG_DICTIONARY);
static int janet_core_next(JanetArgs args) {
Janet ds;
const JanetKV *kv;
JANET_FIXARITY(args, 2);
JANET_CHECKMANY(args, 0, JANET_TFLAG_DICTIONARY);
ds = args.v[0];
if (dst_checktype(ds, DST_TABLE)) {
DstTable *t = dst_unwrap_table(ds);
kv = dst_checktype(args.v[1], DST_NIL)
if (janet_checktype(ds, JANET_TABLE)) {
JanetTable *t = janet_unwrap_table(ds);
kv = janet_checktype(args.v[1], JANET_NIL)
? NULL
: dst_table_find(t, args.v[1]);
kv = dst_table_next(t, kv);
: janet_table_find(t, args.v[1]);
kv = janet_table_next(t, kv);
} else {
const DstKV *st = dst_unwrap_struct(ds);
kv = dst_checktype(args.v[1], DST_NIL)
const JanetKV *st = janet_unwrap_struct(ds);
kv = janet_checktype(args.v[1], JANET_NIL)
? NULL
: dst_struct_find(st, args.v[1]);
kv = dst_struct_next(st, kv);
: janet_struct_find(st, args.v[1]);
kv = janet_struct_next(st, kv);
}
if (kv)
DST_RETURN(args, kv->key);
DST_RETURN_NIL(args);
JANET_RETURN(args, kv->key);
JANET_RETURN_NIL(args);
}
static int dst_core_hash(DstArgs args) {
DST_FIXARITY(args, 1);
DST_RETURN_INTEGER(args, dst_hash(args.v[0]));
static int janet_core_hash(JanetArgs args) {
JANET_FIXARITY(args, 1);
JANET_RETURN_INTEGER(args, janet_hash(args.v[0]));
}
static const DstReg cfuns[] = {
#ifdef DST_DYNAMIC_MODULES
{"native", dst_core_native},
static const JanetReg cfuns[] = {
#ifdef JANET_DYNAMIC_MODULES
{"native", janet_core_native},
#endif
{"print", dst_core_print},
{"describe", dst_core_describe},
{"string", dst_core_string},
{"symbol", dst_core_symbol},
{"buffer", dst_core_buffer},
{"table", dst_core_table},
{"array", dst_core_array},
{"scan-number", dst_core_scannumber},
{"scan-integer", dst_core_scaninteger},
{"scan-real", dst_core_scanreal},
{"tuple", dst_core_tuple},
{"struct", dst_core_struct},
{"buffer", dst_core_buffer},
{"gensym", dst_core_gensym},
{"gccollect", dst_core_gccollect},
{"gcsetinterval", dst_core_gcsetinterval},
{"gcinterval", dst_core_gcinterval},
{"type", dst_core_type},
{"next", dst_core_next},
{"hash", dst_core_hash},
{"print", janet_core_print},
{"describe", janet_core_describe},
{"string", janet_core_string},
{"symbol", janet_core_symbol},
{"buffer", janet_core_buffer},
{"table", janet_core_table},
{"array", janet_core_array},
{"scan-number", janet_core_scannumber},
{"scan-integer", janet_core_scaninteger},
{"scan-real", janet_core_scanreal},
{"tuple", janet_core_tuple},
{"struct", janet_core_struct},
{"buffer", janet_core_buffer},
{"gensym", janet_core_gensym},
{"gccollect", janet_core_gccollect},
{"gcsetinterval", janet_core_gcsetinterval},
{"gcinterval", janet_core_gcinterval},
{"type", janet_core_type},
{"next", janet_core_next},
{"hash", janet_core_hash},
{NULL, NULL}
};
/* Utility for inline assembly */
static void dst_quick_asm(
DstTable *env,
static void janet_quick_asm(
JanetTable *env,
int32_t flags,
const char *name,
int32_t arity,
int32_t slots,
const uint32_t *bytecode,
size_t bytecode_size) {
DstFuncDef *def = dst_funcdef_alloc();
JanetFuncDef *def = janet_funcdef_alloc();
def->arity = arity;
def->flags = flags;
def->slotcount = slots;
def->bytecode = malloc(bytecode_size);
def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t));
def->name = dst_cstring(name);
def->name = janet_cstring(name);
if (!def->bytecode) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, bytecode, bytecode_size);
dst_def(env, name, dst_wrap_function(dst_thunk(def)));
dst_register(name, dst_wrap_function(dst_thunk(def)));
janet_def(env, name, janet_wrap_function(janet_thunk(def)));
janet_register(name, janet_wrap_function(janet_thunk(def)));
}
/* Macros for easier inline dst assembly */
/* Macros for easier inline janet assembly */
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
@ -354,7 +354,7 @@ static void dst_quick_asm(
/* Templatize a varop */
static void templatize_varop(
DstTable *env,
JanetTable *env,
int32_t flags,
const char *name,
int32_t nullary,
@ -369,42 +369,42 @@ static void templatize_varop(
/* Reg 4: Next operand (operand) */
/* Reg 5: Loop iterator (i) */
uint32_t varop_asm[] = {
SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
SS(JOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
/* Check nullary */
SSS(DOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
SI(DOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
SSS(JOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
SI(JOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
/* Nullary */
SI(DOP_LOAD_INTEGER, 3, nullary), /* accum = nullary value */
S(DOP_RETURN, 3), /* return accum */
SI(JOP_LOAD_INTEGER, 3, nullary), /* accum = nullary value */
S(JOP_RETURN, 3), /* return accum */
/* Check unary */
SSI(DOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
SI(DOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
SSI(JOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
SI(JOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
/* Unary */
SI(DOP_LOAD_INTEGER, 3, unary), /* accum = unary value */
SSI(DOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
SI(JOP_LOAD_INTEGER, 3, unary), /* accum = unary value */
SSI(JOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
SSS(op, 3, 3, 4), /* accum = accum op operand */
S(DOP_RETURN, 3), /* return accum */
S(JOP_RETURN, 3), /* return accum */
/* Mutli (2 or more) arity */
/* Prime loop */
SSI(DOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
SSI(JOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */
/* Main loop */
SSS(DOP_GET, 4, 0, 5), /* operand = args[i] */
SSS(JOP_GET, 4, 0, 5), /* operand = args[i] */
SSS(op, 3, 3, 4), /* accum = accum op operand */
SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
SI(DOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SSI(JOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
SI(JOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
/* Done, do last and return accumulator */
S(DOP_RETURN, 3) /* return accum */
S(JOP_RETURN, 3) /* return accum */
};
dst_quick_asm(
janet_quick_asm(
env,
flags | DST_FUNCDEF_FLAG_VARARG,
flags | JANET_FUNCDEF_FLAG_VARARG,
name,
0,
6,
@ -414,7 +414,7 @@ static void templatize_varop(
/* Templatize variadic comparators */
static void templatize_comparator(
DstTable *env,
JanetTable *env,
int32_t flags,
const char *name,
int invert,
@ -427,35 +427,35 @@ static void templatize_comparator(
/* Reg 4: Next operand (next) */
/* Reg 5: Loop iterator (i) */
uint32_t comparator_asm[] = {
SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
SSS(DOP_LESS_THAN_IMMEDIATE, 2, 1, 2), /* Check if numargs less than 2 */
SI(DOP_JUMP_IF, 2, 10), /* If numargs < 2, jump to done */
SS(JOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
SSS(JOP_LESS_THAN_IMMEDIATE, 2, 1, 2), /* Check if numargs less than 2 */
SI(JOP_JUMP_IF, 2, 10), /* If numargs < 2, jump to done */
/* Prime loop */
SSI(DOP_GET_INDEX, 3, 0, 0), /* last = args[0] */
SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
SSI(JOP_GET_INDEX, 3, 0, 0), /* last = args[0] */
SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */
/* Main loop */
SSS(DOP_GET, 4, 0, 5), /* next = args[i] */
SSS(JOP_GET, 4, 0, 5), /* next = args[i] */
SSS(op, 2, 3, 4), /* jump? = last compare next */
SI(DOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SS(DOP_MOVE_NEAR, 3, 4), /* last = next */
SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
SI(DOP_JUMP_IF_NOT, 2, -6), /* if not jump? go back 6 */
SI(JOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SS(JOP_MOVE_NEAR, 3, 4), /* last = next */
SSI(JOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
SI(JOP_JUMP_IF_NOT, 2, -6), /* if not jump? go back 6 */
/* Done, return true */
S(invert ? DOP_LOAD_FALSE : DOP_LOAD_TRUE, 3),
S(DOP_RETURN, 3),
S(invert ? JOP_LOAD_FALSE : JOP_LOAD_TRUE, 3),
S(JOP_RETURN, 3),
/* Failed, return false */
S(invert ? DOP_LOAD_TRUE : DOP_LOAD_FALSE, 3),
S(DOP_RETURN, 3)
S(invert ? JOP_LOAD_TRUE : JOP_LOAD_FALSE, 3),
S(JOP_RETURN, 3)
};
dst_quick_asm(
janet_quick_asm(
env,
flags | DST_FUNCDEF_FLAG_VARARG,
flags | JANET_FUNCDEF_FLAG_VARARG,
name,
0,
6,
@ -464,7 +464,7 @@ static void templatize_comparator(
}
/* Make the apply function */
static void make_apply(DstTable *env) {
static void make_apply(JanetTable *env) {
/* Reg 0: Function (fun) */
/* Reg 1: Argument tuple (args) */
/* Reg 2: Argument count (argn) */
@ -472,138 +472,138 @@ static void make_apply(DstTable *env) {
/* Reg 4: Loop iterator (i) */
/* Reg 5: Loop values (x) */
uint32_t apply_asm[] = {
SS(DOP_LENGTH, 2, 1),
SSS(DOP_EQUALS_IMMEDIATE, 3, 2, 0), /* Immediate tail call if no args */
SI(DOP_JUMP_IF, 3, 9),
SS(JOP_LENGTH, 2, 1),
SSS(JOP_EQUALS_IMMEDIATE, 3, 2, 0), /* Immediate tail call if no args */
SI(JOP_JUMP_IF, 3, 9),
/* Prime loop */
SI(DOP_LOAD_INTEGER, 4, 0), /* i = 0 */
SI(JOP_LOAD_INTEGER, 4, 0), /* i = 0 */
/* Main loop */
SSS(DOP_GET, 5, 1, 4), /* x = args[i] */
SSI(DOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */
SSI(DOP_EQUALS_INTEGER, 3, 4, 2), /* jump? = (i == argn) */
SI(DOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */
S(DOP_PUSH, 5),
(DOP_JUMP | ((uint32_t)(-5) << 8)),
SSS(JOP_GET, 5, 1, 4), /* x = args[i] */
SSI(JOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */
SSI(JOP_EQUALS_INTEGER, 3, 4, 2), /* jump? = (i == argn) */
SI(JOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */
S(JOP_PUSH, 5),
(JOP_JUMP | ((uint32_t)(-5) << 8)),
/* Push the array */
S(DOP_PUSH_ARRAY, 5),
S(JOP_PUSH_ARRAY, 5),
/* Call the funciton */
S(DOP_TAILCALL, 0)
S(JOP_TAILCALL, 0)
};
dst_quick_asm(env, DST_FUN_APPLY | DST_FUNCDEF_FLAG_VARARG,
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 6, apply_asm, sizeof(apply_asm));
}
DstTable *dst_core_env(void) {
JanetTable *janet_core_env(void) {
static const uint32_t error_asm[] = {
DOP_ERROR
JOP_ERROR
};
static const uint32_t debug_asm[] = {
DOP_SIGNAL | (2 << 24),
DOP_RETURN_NIL
JOP_SIGNAL | (2 << 24),
JOP_RETURN_NIL
};
static const uint32_t yield_asm[] = {
DOP_SIGNAL | (3 << 24),
DOP_RETURN
JOP_SIGNAL | (3 << 24),
JOP_RETURN
};
static const uint32_t resume_asm[] = {
DOP_RESUME | (1 << 24),
DOP_RETURN
JOP_RESUME | (1 << 24),
JOP_RETURN
};
static const uint32_t get_asm[] = {
DOP_GET | (1 << 24),
DOP_RETURN
JOP_GET | (1 << 24),
JOP_RETURN
};
static const uint32_t put_asm[] = {
DOP_PUT | (1 << 16) | (2 << 24),
DOP_RETURN
JOP_PUT | (1 << 16) | (2 << 24),
JOP_RETURN
};
static const uint32_t length_asm[] = {
DOP_LENGTH,
DOP_RETURN
JOP_LENGTH,
JOP_RETURN
};
static const uint32_t bnot_asm[] = {
DOP_BNOT,
DOP_RETURN
JOP_BNOT,
JOP_RETURN
};
DstTable *env = dst_table(0);
Dst ret = dst_wrap_table(env);
JanetTable *env = janet_table(0);
Janet ret = janet_wrap_table(env);
/* Load main functions */
dst_cfuns(env, NULL, cfuns);
janet_cfuns(env, NULL, cfuns);
dst_quick_asm(env, DST_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm));
dst_quick_asm(env, DST_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm));
dst_quick_asm(env, DST_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm));
dst_quick_asm(env, DST_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm));
dst_quick_asm(env, DST_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm));
dst_quick_asm(env, DST_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm));
dst_quick_asm(env, DST_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm));
dst_quick_asm(env, DST_FUN_BNOT, "~", 1, 1, bnot_asm, sizeof(bnot_asm));
janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm));
janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm));
janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm));
janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm));
janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm));
janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm));
janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm));
janet_quick_asm(env, JANET_FUN_BNOT, "~", 1, 1, bnot_asm, sizeof(bnot_asm));
make_apply(env);
/* Variadic ops */
templatize_varop(env, DST_FUN_ADD, "+", 0, 0, DOP_ADD);
templatize_varop(env, DST_FUN_SUBTRACT, "-", 0, 0, DOP_SUBTRACT);
templatize_varop(env, DST_FUN_MULTIPLY, "*", 1, 1, DOP_MULTIPLY);
templatize_varop(env, DST_FUN_DIVIDE, "/", 1, 1, DOP_DIVIDE);
templatize_varop(env, DST_FUN_BAND, "&", -1, -1, DOP_BAND);
templatize_varop(env, DST_FUN_BOR, "|", 0, 0, DOP_BOR);
templatize_varop(env, DST_FUN_BXOR, "^", 0, 0, DOP_BXOR);
templatize_varop(env, DST_FUN_LSHIFT, "<<", 1, 1, DOP_SHIFT_LEFT);
templatize_varop(env, DST_FUN_RSHIFT, ">>", 1, 1, DOP_SHIFT_RIGHT);
templatize_varop(env, DST_FUN_RSHIFTU, ">>>", 1, 1, DOP_SHIFT_RIGHT_UNSIGNED);
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD);
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT);
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY);
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE);
templatize_varop(env, JANET_FUN_BAND, "&", -1, -1, JOP_BAND);
templatize_varop(env, JANET_FUN_BOR, "|", 0, 0, JOP_BOR);
templatize_varop(env, JANET_FUN_BXOR, "^", 0, 0, JOP_BXOR);
templatize_varop(env, JANET_FUN_LSHIFT, "<<", 1, 1, JOP_SHIFT_LEFT);
templatize_varop(env, JANET_FUN_RSHIFT, ">>", 1, 1, JOP_SHIFT_RIGHT);
templatize_varop(env, JANET_FUN_RSHIFTU, ">>>", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED);
/* Variadic comparators */
templatize_comparator(env, DST_FUN_ORDER_GT, "order>", 0, DOP_GREATER_THAN);
templatize_comparator(env, DST_FUN_ORDER_LT, "order<", 0, DOP_LESS_THAN);
templatize_comparator(env, DST_FUN_ORDER_GTE, "order>=", 1, DOP_LESS_THAN);
templatize_comparator(env, DST_FUN_ORDER_LTE, "order<=", 1, DOP_GREATER_THAN);
templatize_comparator(env, DST_FUN_ORDER_EQ, "=", 0, DOP_EQUALS);
templatize_comparator(env, DST_FUN_ORDER_NEQ, "not=", 1, DOP_EQUALS);
templatize_comparator(env, DST_FUN_GT, ">", 0, DOP_NUMERIC_GREATER_THAN);
templatize_comparator(env, DST_FUN_LT, "<", 0, DOP_NUMERIC_LESS_THAN);
templatize_comparator(env, DST_FUN_GTE, ">=", 0, DOP_NUMERIC_GREATER_THAN_EQUAL);
templatize_comparator(env, DST_FUN_LTE, "<=", 0, DOP_NUMERIC_LESS_THAN_EQUAL);
templatize_comparator(env, DST_FUN_EQ, "==", 0, DOP_NUMERIC_EQUAL);
templatize_comparator(env, DST_FUN_NEQ, "not==", 1, DOP_NUMERIC_EQUAL);
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN);
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN);
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN);
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN);
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS);
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS);
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN);
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN);
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL);
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL);
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL);
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL);
/* Platform detection */
dst_def(env, "dst.version", dst_cstringv(DST_VERSION));
janet_def(env, "janet.version", janet_cstringv(JANET_VERSION));
/* Set as gc root */
dst_gcroot(dst_wrap_table(env));
janet_gcroot(janet_wrap_table(env));
/* Load auxiliary envs */
{
DstArgs args;
JanetArgs args;
args.n = 1;
args.v = &ret;
args.ret = &ret;
dst_lib_io(args);
dst_lib_math(args);
dst_lib_array(args);
dst_lib_tuple(args);
dst_lib_buffer(args);
dst_lib_table(args);
dst_lib_fiber(args);
dst_lib_os(args);
dst_lib_parse(args);
dst_lib_compile(args);
dst_lib_asm(args);
dst_lib_string(args);
dst_lib_marsh(args);
janet_lib_io(args);
janet_lib_math(args);
janet_lib_array(args);
janet_lib_tuple(args);
janet_lib_buffer(args);
janet_lib_table(args);
janet_lib_fiber(args);
janet_lib_os(args);
janet_lib_parse(args);
janet_lib_compile(args);
janet_lib_asm(args);
janet_lib_string(args);
janet_lib_marsh(args);
}
/* Allow references to the environment */
dst_def(env, "_env", ret);
janet_def(env, "_env", ret);
/* Run bootstrap source */
dst_dobytes(env, dst_gen_core, sizeof(dst_gen_core), "core.dst");
janet_dobytes(env, janet_gen_core, sizeof(janet_gen_core), "core.janet");
return env;
}

262
src/core/emit.c
View File

@ -20,76 +20,76 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "emit.h"
#include "vector.h"
#include "regalloc.h"
/* Get a register */
int32_t dstc_allocfar(DstCompiler *c) {
int32_t reg = dstc_regalloc_1(&c->scope->ra);
int32_t janetc_allocfar(JanetCompiler *c) {
int32_t reg = janetc_regalloc_1(&c->scope->ra);
if (reg > 0xFFFF) {
dstc_cerror(c, "ran out of internal registers");
janetc_cerror(c, "ran out of internal registers");
}
return reg;
}
/* Get a register less than 256 */
int32_t dstc_allocnear(DstCompiler *c, DstcRegisterTemp tag) {
return dstc_regalloc_temp(&c->scope->ra, tag);
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
return janetc_regalloc_temp(&c->scope->ra, tag);
}
/* Emit a raw instruction with source mapping. */
void dstc_emit(DstCompiler *c, uint32_t instr) {
dst_v_push(c->buffer, instr);
dst_v_push(c->mapbuffer, c->current_mapping);
void janetc_emit(JanetCompiler *c, uint32_t instr) {
janet_v_push(c->buffer, instr);
janet_v_push(c->mapbuffer, c->current_mapping);
}
/* Add a constant to the current scope. Return the index of the constant. */
static int32_t dstc_const(DstCompiler *c, Dst x) {
DstScope *scope = c->scope;
static int32_t janetc_const(JanetCompiler *c, Janet x) {
JanetScope *scope = c->scope;
int32_t i, len;
/* Get the topmost function scope */
while (scope) {
if (scope->flags & DST_SCOPE_FUNCTION)
if (scope->flags & JANET_SCOPE_FUNCTION)
break;
scope = scope->parent;
}
/* Check if already added */
len = dst_v_count(scope->consts);
len = janet_v_count(scope->consts);
for (i = 0; i < len; i++) {
if (dst_equals(x, scope->consts[i]))
if (janet_equals(x, scope->consts[i]))
return i;
}
/* Ensure not too many constsants. */
if (len >= 0xFFFF) {
dstc_cerror(c, "too many constants");
janetc_cerror(c, "too many constants");
return 0;
}
dst_v_push(scope->consts, x);
janet_v_push(scope->consts, x);
return len;
}
/* Load a constant into a local register */
static void dstc_loadconst(DstCompiler *c, Dst k, int32_t reg) {
switch (dst_type(k)) {
case DST_NIL:
dstc_emit(c, (reg << 8) | DOP_LOAD_NIL);
static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
switch (janet_type(k)) {
case JANET_NIL:
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
break;
case DST_TRUE:
dstc_emit(c, (reg << 8) | DOP_LOAD_TRUE);
case JANET_TRUE:
janetc_emit(c, (reg << 8) | JOP_LOAD_TRUE);
break;
case DST_FALSE:
dstc_emit(c, (reg << 8) | DOP_LOAD_FALSE);
case JANET_FALSE:
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
break;
case DST_INTEGER:
case JANET_INTEGER:
{
int32_t i = dst_unwrap_integer(k);
int32_t i = janet_unwrap_integer(k);
if (i <= INT16_MAX && i >= INT16_MIN) {
dstc_emit(c,
janetc_emit(c,
(i << 16) |
(reg << 8) |
DOP_LOAD_INTEGER);
JOP_LOAD_INTEGER);
break;
}
goto do_constant;
@ -97,118 +97,118 @@ static void dstc_loadconst(DstCompiler *c, Dst k, int32_t reg) {
default:
do_constant:
{
int32_t cindex = dstc_const(c, k);
dstc_emit(c,
int32_t cindex = janetc_const(c, k);
janetc_emit(c,
(cindex << 16) |
(reg << 8) |
DOP_LOAD_CONSTANT);
JOP_LOAD_CONSTANT);
break;
}
}
}
/* Move a slot to a near register */
static void dstc_movenear(DstCompiler *c,
static void janetc_movenear(JanetCompiler *c,
int32_t dest,
DstSlot src) {
if (src.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF)) {
dstc_loadconst(c, src.constant, dest);
JanetSlot src) {
if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
janetc_loadconst(c, src.constant, dest);
/* If we also are a reference, deref the one element array */
if (src.flags & DST_SLOT_REF) {
dstc_emit(c,
if (src.flags & JANET_SLOT_REF) {
janetc_emit(c,
(dest << 16) |
(dest << 8) |
DOP_GET_INDEX);
JOP_GET_INDEX);
}
} else if (src.envindex >= 0) {
dstc_emit(c,
janetc_emit(c,
((uint32_t)(src.index) << 24) |
((uint32_t)(src.envindex) << 16) |
((uint32_t)(dest) << 8) |
DOP_LOAD_UPVALUE);
JOP_LOAD_UPVALUE);
} else if (src.index > 0xFF || src.index != dest) {
dstc_emit(c,
janetc_emit(c,
((uint32_t)(src.index) << 16) |
((uint32_t)(dest) << 8) |
DOP_MOVE_NEAR);
JOP_MOVE_NEAR);
}
}
/* Move a near register to a Slot. */
static void dstc_moveback(DstCompiler *c,
DstSlot dest,
static void janetc_moveback(JanetCompiler *c,
JanetSlot dest,
int32_t src) {
if (dest.flags & DST_SLOT_REF) {
int32_t refreg = dstc_regalloc_temp(&c->scope->ra, DSTC_REGTEMP_5);
dstc_loadconst(c, dest.constant, refreg);
dstc_emit(c,
if (dest.flags & JANET_SLOT_REF) {
int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
janetc_loadconst(c, dest.constant, refreg);
janetc_emit(c,
(src << 16) |
(refreg << 8) |
DOP_PUT_INDEX);
dstc_regalloc_freetemp(&c->scope->ra, refreg, DSTC_REGTEMP_5);
JOP_PUT_INDEX);
janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
} else if (dest.envindex >= 0) {
dstc_emit(c,
janetc_emit(c,
((uint32_t)(dest.index) << 24) |
((uint32_t)(dest.envindex) << 16) |
((uint32_t)(src) << 8) |
DOP_SET_UPVALUE);
JOP_SET_UPVALUE);
} else if (dest.index != src) {
dstc_emit(c,
janetc_emit(c,
((uint32_t)(dest.index) << 16) |
((uint32_t)(src) << 8) |
DOP_MOVE_FAR);
JOP_MOVE_FAR);
}
}
/* Call this to release a register after emitting the instruction. */
static void dstc_free_regnear(DstCompiler *c, DstSlot s, int32_t reg, DstcRegisterTemp tag) {
static void janetc_free_regnear(JanetCompiler *c, JanetSlot s, int32_t reg, JanetcRegisterTemp tag) {
if (reg != s.index ||
s.envindex >= 0 ||
s.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF)) {
s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
/* We need to free the temporary slot */
dstc_regalloc_freetemp(&c->scope->ra, reg, tag);
janetc_regalloc_freetemp(&c->scope->ra, reg, tag);
}
}
/* Convert a slot to a two byte register */
static int32_t dstc_regfar(DstCompiler *c, DstSlot s, DstcRegisterTemp tag) {
static int32_t janetc_regfar(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp tag) {
/* check if already near register */
if (s.envindex < 0 && s.index >= 0) {
return s.index;
}
int32_t reg;
int32_t nearreg = dstc_regalloc_temp(&c->scope->ra, tag);
dstc_movenear(c, nearreg, s);
int32_t nearreg = janetc_regalloc_temp(&c->scope->ra, tag);
janetc_movenear(c, nearreg, s);
if (nearreg >= 0xF0) {
reg = dstc_allocfar(c);
dstc_emit(c, DOP_MOVE_FAR | (nearreg << 8) | (reg << 16));
dstc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
reg = janetc_allocfar(c);
janetc_emit(c, JOP_MOVE_FAR | (nearreg << 8) | (reg << 16));
janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
} else {
reg = nearreg;
dstc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
dstc_regalloc_touch(&c->scope->ra, reg);
janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
janetc_regalloc_touch(&c->scope->ra, reg);
}
return reg;
}
/* Convert a slot to a temporary 1 byte register */
static int32_t dstc_regnear(DstCompiler *c, DstSlot s, DstcRegisterTemp tag) {
static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp tag) {
/* check if already near register */
if (s.envindex < 0 && s.index >= 0 && s.index <= 0xFF) {
return s.index;
}
int32_t reg = dstc_regalloc_temp(&c->scope->ra, tag);
dstc_movenear(c, reg, s);
int32_t reg = janetc_regalloc_temp(&c->scope->ra, tag);
janetc_movenear(c, reg, s);
return reg;
}
/* Check if two slots are equal */
static int dstc_sequal(DstSlot lhs, DstSlot rhs) {
if ((lhs.flags & ~DST_SLOTTYPE_ANY) == (rhs.flags & ~DST_SLOTTYPE_ANY) &&
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
lhs.index == rhs.index &&
lhs.envindex == rhs.envindex) {
if (lhs.flags & (DST_SLOT_REF | DST_SLOT_CONSTANT)) {
return dst_equals(lhs.constant, rhs.constant);
if (lhs.flags & (JANET_SLOT_REF | JANET_SLOT_CONSTANT)) {
return janet_equals(lhs.constant, rhs.constant);
} else {
return 1;
}
@ -218,118 +218,118 @@ static int dstc_sequal(DstSlot lhs, DstSlot rhs) {
/* Move values from one slot to another. The destination must
* be writeable (not a literal). */
void dstc_copy(
DstCompiler *c,
DstSlot dest,
DstSlot src) {
if (dest.flags & DST_SLOT_CONSTANT) {
dstc_cerror(c, "cannot write to constant");
void janetc_copy(
JanetCompiler *c,
JanetSlot dest,
JanetSlot src) {
if (dest.flags & JANET_SLOT_CONSTANT) {
janetc_cerror(c, "cannot write to constant");
return;
}
if (dstc_sequal(dest, src)) return;
if (janetc_sequal(dest, src)) return;
/* If dest is a near register */
if (dest.envindex < 0 && dest.index >= 0 && dest.index <= 0xFF) {
dstc_movenear(c, dest.index, src);
janetc_movenear(c, dest.index, src);
return;
}
/* If src is a near register */
if (src.envindex < 0 && src.index >= 0 && src.index <= 0xFF) {
dstc_moveback(c, dest, src.index);
janetc_moveback(c, dest, src.index);
return;
}
/* Process: src -> near -> dest */
int32_t near = dstc_allocnear(c, DSTC_REGTEMP_3);
dstc_movenear(c, near, src);
dstc_moveback(c, dest, near);
int32_t near = janetc_allocnear(c, JANETC_REGTEMP_3);
janetc_movenear(c, near, src);
janetc_moveback(c, dest, near);
/* Cleanup */
dstc_regalloc_freetemp(&c->scope->ra, near, DSTC_REGTEMP_3);
janetc_regalloc_freetemp(&c->scope->ra, near, JANETC_REGTEMP_3);
}
/* Instruction templated emitters */
static int32_t emit1s(DstCompiler *c, uint8_t op, DstSlot s, int32_t rest, int wr) {
int32_t reg = dstc_regnear(c, s, DSTC_REGTEMP_0);
int32_t label = dst_v_count(c->buffer);
dstc_emit(c, op | (reg << 8) | (rest << 16));
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg << 8) | (rest << 16));
if (wr)
dstc_moveback(c, s, reg);
dstc_free_regnear(c, s, reg, DSTC_REGTEMP_0);
janetc_moveback(c, s, reg);
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
return label;
}
int32_t dstc_emit_s(DstCompiler *c, uint8_t op, DstSlot s, int wr) {
int32_t reg = dstc_regfar(c, s, DSTC_REGTEMP_0);
int32_t label = dst_v_count(c->buffer);
dstc_emit(c, op | (reg << 8));
int32_t janetc_emit_s(JanetCompiler *c, uint8_t op, JanetSlot s, int wr) {
int32_t reg = janetc_regfar(c, s, JANETC_REGTEMP_0);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg << 8));
if (wr)
dstc_moveback(c, s, reg);
dstc_free_regnear(c, s, reg, DSTC_REGTEMP_0);
janetc_moveback(c, s, reg);
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
return label;
}
int32_t dstc_emit_sl(DstCompiler *c, uint8_t op, DstSlot s, int32_t label) {
int32_t current = dst_v_count(c->buffer) - 1;
int32_t janetc_emit_sl(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t label) {
int32_t current = janet_v_count(c->buffer) - 1;
int32_t jump = label - current;
if (jump < INT16_MIN || jump > INT16_MAX) {
dstc_cerror(c, "jump is too far");
janetc_cerror(c, "jump is too far");
}
return emit1s(c, op, s, jump, 0);
}
int32_t dstc_emit_st(DstCompiler *c, uint8_t op, DstSlot s, int32_t tflags) {
int32_t janetc_emit_st(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t tflags) {
return emit1s(c, op, s, tflags, 0);
}
int32_t dstc_emit_si(DstCompiler *c, uint8_t op, DstSlot s, int16_t immediate, int wr) {
int32_t janetc_emit_si(JanetCompiler *c, uint8_t op, JanetSlot s, int16_t immediate, int wr) {
return emit1s(c, op, s, immediate, wr);
}
int32_t dstc_emit_su(DstCompiler *c, uint8_t op, DstSlot s, uint16_t immediate, int wr) {
int32_t janetc_emit_su(JanetCompiler *c, uint8_t op, JanetSlot s, uint16_t immediate, int wr) {
return emit1s(c, op, s, (int32_t) immediate, wr);
}
static int32_t emit2s(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, int32_t rest, int wr) {
int32_t reg1 = dstc_regnear(c, s1, DSTC_REGTEMP_0);
int32_t reg2 = dstc_regnear(c, s2, DSTC_REGTEMP_1);
int32_t label = dst_v_count(c->buffer);
dstc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (rest << 24));
dstc_free_regnear(c, s2, reg2, DSTC_REGTEMP_1);
static int32_t emit2s(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int32_t rest, int wr) {
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (rest << 24));
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
if (wr)
dstc_moveback(c, s1, reg1);
dstc_free_regnear(c, s1, reg1, DSTC_REGTEMP_0);
janetc_moveback(c, s1, reg1);
janetc_free_regnear(c, s1, reg1, JANETC_REGTEMP_0);
return label;
}
int32_t dstc_emit_ss(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, int wr) {
int32_t reg1 = dstc_regnear(c, s1, DSTC_REGTEMP_0);
int32_t reg2 = dstc_regfar(c, s2, DSTC_REGTEMP_1);
int32_t label = dst_v_count(c->buffer);
dstc_emit(c, op | (reg1 << 8) | (reg2 << 16));
dstc_free_regnear(c, s2, reg2, DSTC_REGTEMP_1);
int32_t janetc_emit_ss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int wr) {
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
int32_t reg2 = janetc_regfar(c, s2, JANETC_REGTEMP_1);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16));
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
if (wr)
dstc_moveback(c, s1, reg1);
dstc_free_regnear(c, s1, reg1, DSTC_REGTEMP_0);
janetc_moveback(c, s1, reg1);
janetc_free_regnear(c, s1, reg1, JANETC_REGTEMP_0);
return label;
}
int32_t dstc_emit_ssi(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, int8_t immediate, int wr) {
int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int8_t immediate, int wr) {
return emit2s(c, op, s1, s2, immediate, wr);
}
int32_t dstc_emit_ssu(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, uint8_t immediate, int wr) {
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr) {
return emit2s(c, op, s1, s2, (int32_t) immediate, wr);
}
int32_t dstc_emit_sss(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, DstSlot s3, int wr) {
int32_t reg1 = dstc_regnear(c, s1, DSTC_REGTEMP_0);
int32_t reg2 = dstc_regnear(c, s2, DSTC_REGTEMP_1);
int32_t reg3 = dstc_regnear(c, s3, DSTC_REGTEMP_2);
int32_t label = dst_v_count(c->buffer);
dstc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (reg3 << 24));
dstc_free_regnear(c, s2, reg2, DSTC_REGTEMP_1);
dstc_free_regnear(c, s3, reg3, DSTC_REGTEMP_2);
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr) {
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (reg3 << 24));
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
if (wr)
dstc_moveback(c, s1, reg1);
dstc_free_regnear(c, s1, reg1, DSTC_REGTEMP_0);
janetc_moveback(c, s1, reg1);
janetc_free_regnear(c, s1, reg1, JANETC_REGTEMP_0);
return label;
}

30
src/core/emit.h
View File

@ -20,27 +20,27 @@
* IN THE SOFTWARE.
*/
#ifndef DST_EMIT_H
#define DST_EMIT_H
#ifndef JANET_EMIT_H
#define JANET_EMIT_H
#include "compile.h"
void dstc_emit(DstCompiler *c, uint32_t instr);
void janetc_emit(JanetCompiler *c, uint32_t instr);
int32_t dstc_allocfar(DstCompiler *c);
int32_t dstc_allocnear(DstCompiler *c, DstcRegisterTemp);
int32_t janetc_allocfar(JanetCompiler *c);
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp);
int32_t dstc_emit_s(DstCompiler *c, uint8_t op, DstSlot s, int wr);
int32_t dstc_emit_sl(DstCompiler *c, uint8_t op, DstSlot s, int32_t label);
int32_t dstc_emit_st(DstCompiler *c, uint8_t op, DstSlot s, int32_t tflags);
int32_t dstc_emit_si(DstCompiler *c, uint8_t op, DstSlot s, int16_t immediate, int wr);
int32_t dstc_emit_su(DstCompiler *c, uint8_t op, DstSlot s, uint16_t immediate, int wr);
int32_t dstc_emit_ss(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, int wr);
int32_t dstc_emit_ssi(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, int8_t immediate, int wr);
int32_t dstc_emit_ssu(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, uint8_t immediate, int wr);
int32_t dstc_emit_sss(DstCompiler *c, uint8_t op, DstSlot s1, DstSlot s2, DstSlot s3, int wr);
int32_t janetc_emit_s(JanetCompiler *c, uint8_t op, JanetSlot s, int wr);
int32_t janetc_emit_sl(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t label);
int32_t janetc_emit_st(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t tflags);
int32_t janetc_emit_si(JanetCompiler *c, uint8_t op, JanetSlot s, int16_t immediate, int wr);
int32_t janetc_emit_su(JanetCompiler *c, uint8_t op, JanetSlot s, uint16_t immediate, int wr);
int32_t janetc_emit_ss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int wr);
int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int8_t immediate, int wr);
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
/* Move value from one slot to another. Cannot copy to constant slots. */
void dstc_copy(DstCompiler *c, DstSlot dest, DstSlot src);
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);
#endif

330
src/core/fiber.c
View File

@ -20,64 +20,64 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "fiber.h"
#include "state.h"
#include "gc.h"
/* Initialize a new fiber */
DstFiber *dst_fiber(DstFunction *callee, int32_t capacity) {
DstFiber *fiber = dst_gcalloc(DST_MEMORY_FIBER, sizeof(DstFiber));
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
if (capacity < 16) {
capacity = 16;
}
fiber->capacity = capacity;
if (capacity) {
Dst *data = malloc(sizeof(Dst) * capacity);
Janet *data = malloc(sizeof(Janet) * capacity);
if (NULL == data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
fiber->data = data;
}
fiber->maxstack = DST_STACK_MAX;
return dst_fiber_reset(fiber, callee);
fiber->maxstack = JANET_STACK_MAX;
return janet_fiber_reset(fiber, callee);
}
/* Clear a fiber (reset it) */
DstFiber *dst_fiber_reset(DstFiber *fiber, DstFunction *callee) {
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee) {
fiber->frame = 0;
fiber->stackstart = DST_FRAME_SIZE;
fiber->stacktop = DST_FRAME_SIZE;
fiber->stackstart = JANET_FRAME_SIZE;
fiber->stacktop = JANET_FRAME_SIZE;
fiber->root = callee;
fiber->child = NULL;
fiber->flags = DST_FIBER_MASK_YIELD;
dst_fiber_set_status(fiber, DST_STATUS_NEW);
fiber->flags = JANET_FIBER_MASK_YIELD;
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
return fiber;
}
/* Ensure that the fiber has enough extra capacity */
void dst_fiber_setcapacity(DstFiber *fiber, int32_t n) {
Dst *newData = realloc(fiber->data, sizeof(Dst) * n);
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
if (NULL == newData) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
fiber->data = newData;
fiber->capacity = n;
}
/* Push a value on the next stack frame */
void dst_fiber_push(DstFiber *fiber, Dst x) {
void janet_fiber_push(JanetFiber *fiber, Janet x) {
if (fiber->stacktop >= fiber->capacity) {
dst_fiber_setcapacity(fiber, 2 * fiber->stacktop);
janet_fiber_setcapacity(fiber, 2 * fiber->stacktop);
}
fiber->data[fiber->stacktop++] = x;
}
/* Push 2 values on the next stack frame */
void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y) {
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
int32_t newtop = fiber->stacktop + 2;
if (newtop > fiber->capacity) {
dst_fiber_setcapacity(fiber, 2 * newtop);
janet_fiber_setcapacity(fiber, 2 * newtop);
}
fiber->data[fiber->stacktop] = x;
fiber->data[fiber->stacktop + 1] = y;
@ -85,10 +85,10 @@ void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y) {
}
/* Push 3 values on the next stack frame */
void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z) {
void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
int32_t newtop = fiber->stacktop + 3;
if (newtop > fiber->capacity) {
dst_fiber_setcapacity(fiber, 2 * newtop);
janet_fiber_setcapacity(fiber, 2 * newtop);
}
fiber->data[fiber->stacktop] = x;
fiber->data[fiber->stacktop + 1] = y;
@ -97,45 +97,45 @@ void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z) {
}
/* Push an array on the next stack frame */
void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n) {
void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
int32_t newtop = fiber->stacktop + n;
if (newtop > fiber->capacity) {
dst_fiber_setcapacity(fiber, 2 * newtop);
janet_fiber_setcapacity(fiber, 2 * newtop);
}
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Dst));
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
fiber->stacktop = newtop;
}
/* Push a stack frame to a fiber */
int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
DstStackFrame *newframe;
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
JanetStackFrame *newframe;
int32_t i;
int32_t oldtop = fiber->stacktop;
int32_t oldframe = fiber->frame;
int32_t nextframe = fiber->stackstart;
int32_t nextstacktop = nextframe + func->def->slotcount + DST_FRAME_SIZE;
int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
/* Check strict arity */
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
return 1;
}
}
if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
}
/* Nil unset stack arguments (Needed for gc correctness) */
for (i = fiber->stacktop; i < nextstacktop; ++i) {
fiber->data[i] = dst_wrap_nil();
fiber->data[i] = janet_wrap_nil();
}
/* Set up the next frame */
fiber->frame = nextframe;
fiber->stacktop = fiber->stackstart = nextstacktop;
newframe = dst_fiber_frame(fiber);
newframe = janet_fiber_frame(fiber);
newframe->prevframe = oldframe;
newframe->pc = func->def->bytecode;
newframe->func = func;
@ -143,12 +143,12 @@ int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
newframe->flags = 0;
/* Check varargs */
if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) {
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
int32_t tuplehead = fiber->frame + func->def->arity;
if (tuplehead >= oldtop) {
fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(NULL, 0));
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
} else {
fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead,
oldtop - tuplehead));
}
@ -160,13 +160,13 @@ int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
/* If a frame has a closure environment, detach it from
* the stack and have it keep its own values */
static void dst_env_detach(DstFuncEnv *env) {
static void janet_env_detach(JanetFuncEnv *env) {
/* Check for closure environment */
if (env) {
size_t s = sizeof(Dst) * env->length;
Dst *vmem = malloc(s);
size_t s = sizeof(Janet) * env->length;
Janet *vmem = malloc(s);
if (NULL == vmem) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
memcpy(vmem, env->as.fiber->data + env->offset, s);
env->offset = 0;
@ -175,40 +175,40 @@ static void dst_env_detach(DstFuncEnv *env) {
}
/* Create a tail frame for a function */
int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
int32_t i;
int32_t nextframetop = fiber->frame + func->def->slotcount;
int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
int32_t nextstacktop = nextframetop + JANET_FRAME_SIZE;
int32_t stacksize;
/* Check strict arity */
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
return 1;
}
}
if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
}
Dst *stack = fiber->data + fiber->frame;
Dst *args = fiber->data + fiber->stackstart;
Janet *stack = fiber->data + fiber->frame;
Janet *args = fiber->data + fiber->stackstart;
/* Detatch old function */
if (NULL != dst_fiber_frame(fiber)->func)
dst_env_detach(dst_fiber_frame(fiber)->env);
dst_fiber_frame(fiber)->env = NULL;
if (NULL != janet_fiber_frame(fiber)->func)
janet_env_detach(janet_fiber_frame(fiber)->env);
janet_fiber_frame(fiber)->env = NULL;
/* Check varargs */
if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) {
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
int32_t tuplehead = fiber->stackstart + func->def->arity;
if (tuplehead >= fiber->stacktop) {
if (tuplehead >= fiber->capacity) dst_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = dst_wrap_nil();
fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(NULL, 0));
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
} else {
fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead,
fiber->stacktop - tuplehead));
}
@ -217,40 +217,40 @@ int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
stacksize = fiber->stacktop - fiber->stackstart;
}
if (stacksize) memmove(stack, args, stacksize * sizeof(Dst));
if (stacksize) memmove(stack, args, stacksize * sizeof(Janet));
/* Nil unset locals (Needed for functional correctness) */
for (i = fiber->frame + stacksize; i < nextframetop; ++i)
fiber->data[i] = dst_wrap_nil();
fiber->data[i] = janet_wrap_nil();
/* Set stack stuff */
fiber->stacktop = fiber->stackstart = nextstacktop;
/* Set frame stuff */
dst_fiber_frame(fiber)->func = func;
dst_fiber_frame(fiber)->pc = func->def->bytecode;
dst_fiber_frame(fiber)->flags |= DST_STACKFRAME_TAILCALL;
janet_fiber_frame(fiber)->func = func;
janet_fiber_frame(fiber)->pc = func->def->bytecode;
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_TAILCALL;
/* Good return */
return 0;
}
/* Push a stack frame to a fiber for a c function */
void dst_fiber_cframe(DstFiber *fiber, DstCFunction cfun) {
DstStackFrame *newframe;
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
JanetStackFrame *newframe;
int32_t oldframe = fiber->frame;
int32_t nextframe = fiber->stackstart;
int32_t nextstacktop = fiber->stacktop + DST_FRAME_SIZE;
int32_t nextstacktop = fiber->stacktop + JANET_FRAME_SIZE;
if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
}
/* Set the next frame */
fiber->frame = nextframe;
fiber->stacktop = fiber->stackstart = nextstacktop;
newframe = dst_fiber_frame(fiber);
newframe = janet_fiber_frame(fiber);
/* Set up the new frame */
newframe->prevframe = oldframe;
@ -262,13 +262,13 @@ void dst_fiber_cframe(DstFiber *fiber, DstCFunction cfun) {
/* Pop a stack frame from the fiber. Returns the new stack frame, or
* NULL if there are no more frames */
void dst_fiber_popframe(DstFiber *fiber) {
DstStackFrame *frame = dst_fiber_frame(fiber);
void janet_fiber_popframe(JanetFiber *fiber) {
JanetStackFrame *frame = janet_fiber_frame(fiber);
if (fiber->frame == 0) return;
/* Clean up the frame (detach environments) */
if (NULL != frame->func)
dst_env_detach(frame->env);
janet_env_detach(frame->env);
/* Shrink stack */
fiber->stacktop = fiber->stackstart = fiber->frame;
@ -277,184 +277,184 @@ void dst_fiber_popframe(DstFiber *fiber) {
/* CFuns */
static int cfun_new(DstArgs args) {
DstFiber *fiber;
DstFunction *func;
DST_MINARITY(args, 1);
DST_MAXARITY(args, 2);
DST_ARG_FUNCTION(func, args, 0);
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
static int cfun_new(JanetArgs args) {
JanetFiber *fiber;
JanetFunction *func;
JANET_MINARITY(args, 1);
JANET_MAXARITY(args, 2);
JANET_ARG_FUNCTION(func, args, 0);
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != 1) {
DST_THROW(args, "expected unit arity function in fiber constructor");
JANET_THROW(args, "expected unit arity function in fiber constructor");
}
}
fiber = dst_fiber(func, 64);
fiber = janet_fiber(func, 64);
if (args.n == 2) {
const uint8_t *flags;
int32_t len, i;
DST_ARG_BYTES(flags, len, args, 1);
JANET_ARG_BYTES(flags, len, args, 1);
fiber->flags = 0;
dst_fiber_set_status(fiber, DST_STATUS_NEW);
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
for (i = 0; i < len; i++) {
if (flags[i] >= '0' && flags[i] <= '9') {
fiber->flags |= DST_FIBER_MASK_USERN(flags[i] - '0');
fiber->flags |= JANET_FIBER_MASK_USERN(flags[i] - '0');
} else {
switch (flags[i]) {
default:
DST_THROW(args, "invalid flag, expected a, d, e, u, or y");
JANET_THROW(args, "invalid flag, expected a, d, e, u, or y");
case ':':
break;
case 'a':
fiber->flags |=
DST_FIBER_MASK_DEBUG |
DST_FIBER_MASK_ERROR |
DST_FIBER_MASK_USER |
DST_FIBER_MASK_YIELD;
JANET_FIBER_MASK_DEBUG |
JANET_FIBER_MASK_ERROR |
JANET_FIBER_MASK_USER |
JANET_FIBER_MASK_YIELD;
break;
case 'd':
fiber->flags |= DST_FIBER_MASK_DEBUG;
fiber->flags |= JANET_FIBER_MASK_DEBUG;
break;
case 'e':
fiber->flags |= DST_FIBER_MASK_ERROR;
fiber->flags |= JANET_FIBER_MASK_ERROR;
break;
case 'u':
fiber->flags |= DST_FIBER_MASK_USER;
fiber->flags |= JANET_FIBER_MASK_USER;
break;
case 'y':
fiber->flags |= DST_FIBER_MASK_YIELD;
fiber->flags |= JANET_FIBER_MASK_YIELD;
break;
}
}
}
}
DST_RETURN_FIBER(args, fiber);
JANET_RETURN_FIBER(args, fiber);
}
static int cfun_status(DstArgs args) {
DstFiber *fiber;
static int cfun_status(JanetArgs args) {
JanetFiber *fiber;
const char *status = "";
DST_FIXARITY(args, 1);
DST_ARG_FIBER(fiber, args, 0);
uint32_t s = (fiber->flags & DST_FIBER_STATUS_MASK) >>
DST_FIBER_STATUS_OFFSET;
JANET_FIXARITY(args, 1);
JANET_ARG_FIBER(fiber, args, 0);
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
JANET_FIBER_STATUS_OFFSET;
switch (s) {
case DST_STATUS_DEAD: status = ":dead"; break;
case DST_STATUS_ERROR: status = ":error"; break;
case DST_STATUS_DEBUG: status = ":debug"; break;
case DST_STATUS_PENDING: status = ":pending"; break;
case DST_STATUS_USER0: status = ":user0"; break;
case DST_STATUS_USER1: status = ":user1"; break;
case DST_STATUS_USER2: status = ":user2"; break;
case DST_STATUS_USER3: status = ":user3"; break;
case DST_STATUS_USER4: status = ":user4"; break;
case DST_STATUS_USER5: status = ":user5"; break;
case DST_STATUS_USER6: status = ":user6"; break;
case DST_STATUS_USER7: status = ":user7"; break;
case DST_STATUS_USER8: status = ":user8"; break;
case DST_STATUS_USER9: status = ":user9"; break;
case DST_STATUS_NEW: status = ":new"; break;
case JANET_STATUS_DEAD: status = ":dead"; break;
case JANET_STATUS_ERROR: status = ":error"; break;
case JANET_STATUS_DEBUG: status = ":debug"; break;
case JANET_STATUS_PENDING: status = ":pending"; break;
case JANET_STATUS_USER0: status = ":user0"; break;
case JANET_STATUS_USER1: status = ":user1"; break;
case JANET_STATUS_USER2: status = ":user2"; break;
case JANET_STATUS_USER3: status = ":user3"; break;
case JANET_STATUS_USER4: status = ":user4"; break;
case JANET_STATUS_USER5: status = ":user5"; break;
case JANET_STATUS_USER6: status = ":user6"; break;
case JANET_STATUS_USER7: status = ":user7"; break;
case JANET_STATUS_USER8: status = ":user8"; break;
case JANET_STATUS_USER9: status = ":user9"; break;
case JANET_STATUS_NEW: status = ":new"; break;
default:
case DST_STATUS_ALIVE: status = ":alive"; break;
case JANET_STATUS_ALIVE: status = ":alive"; break;
}
DST_RETURN_CSYMBOL(args, status);
JANET_RETURN_CSYMBOL(args, status);
}
/* Extract info from one stack frame */
static Dst doframe(DstStackFrame *frame) {
static Janet doframe(JanetStackFrame *frame) {
int32_t off;
DstTable *t = dst_table(3);
DstFuncDef *def = NULL;
JanetTable *t = janet_table(3);
JanetFuncDef *def = NULL;
if (frame->func) {
dst_table_put(t, dst_csymbolv(":function"), dst_wrap_function(frame->func));
janet_table_put(t, janet_csymbolv(":function"), janet_wrap_function(frame->func));
def = frame->func->def;
if (def->name) {
dst_table_put(t, dst_csymbolv(":name"), dst_wrap_string(def->name));
janet_table_put(t, janet_csymbolv(":name"), janet_wrap_string(def->name));
}
} else {
DstCFunction cfun = (DstCFunction)(frame->pc);
JanetCFunction cfun = (JanetCFunction)(frame->pc);
if (cfun) {
Dst name = dst_table_get(dst_vm_registry, dst_wrap_cfunction(cfun));
if (!dst_checktype(name, DST_NIL)) {
dst_table_put(t, dst_csymbolv(":name"), name);
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
if (!janet_checktype(name, JANET_NIL)) {
janet_table_put(t, janet_csymbolv(":name"), name);
}
}
dst_table_put(t, dst_csymbolv(":c"), dst_wrap_true());
janet_table_put(t, janet_csymbolv(":c"), janet_wrap_true());
}
if (frame->flags & DST_STACKFRAME_TAILCALL) {
dst_table_put(t, dst_csymbolv(":tail"), dst_wrap_true());
if (frame->flags & JANET_STACKFRAME_TAILCALL) {
janet_table_put(t, janet_csymbolv(":tail"), janet_wrap_true());
}
if (frame->func && frame->pc) {
off = (int32_t) (frame->pc - def->bytecode);
dst_table_put(t, dst_csymbolv(":pc"), dst_wrap_integer(off));
janet_table_put(t, janet_csymbolv(":pc"), janet_wrap_integer(off));
if (def->sourcemap) {
DstSourceMapping mapping = def->sourcemap[off];
dst_table_put(t, dst_csymbolv(":line"), dst_wrap_integer(mapping.line));
dst_table_put(t, dst_csymbolv(":column"), dst_wrap_integer(mapping.column));
JanetSourceMapping mapping = def->sourcemap[off];
janet_table_put(t, janet_csymbolv(":line"), janet_wrap_integer(mapping.line));
janet_table_put(t, janet_csymbolv(":column"), janet_wrap_integer(mapping.column));
}
if (def->source) {
dst_table_put(t, dst_csymbolv(":source"), dst_wrap_string(def->source));
janet_table_put(t, janet_csymbolv(":source"), janet_wrap_string(def->source));
}
}
return dst_wrap_table(t);
return janet_wrap_table(t);
}
static int cfun_stack(DstArgs args) {
DstFiber *fiber;
DstArray *array;
DST_FIXARITY(args, 1);
DST_ARG_FIBER(fiber, args, 0);
array = dst_array(0);
static int cfun_stack(JanetArgs args) {
JanetFiber *fiber;
JanetArray *array;
JANET_FIXARITY(args, 1);
JANET_ARG_FIBER(fiber, args, 0);
array = janet_array(0);
{
int32_t i = fiber->frame;
DstStackFrame *frame;
JanetStackFrame *frame;
while (i > 0) {
frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE);
dst_array_push(array, doframe(frame));
frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
janet_array_push(array, doframe(frame));
i = frame->prevframe;
}
}
DST_RETURN_ARRAY(args, array);
JANET_RETURN_ARRAY(args, array);
}
static int cfun_current(DstArgs args) {
DST_FIXARITY(args, 0);
DST_RETURN_FIBER(args, dst_vm_fiber);
static int cfun_current(JanetArgs args) {
JANET_FIXARITY(args, 0);
JANET_RETURN_FIBER(args, janet_vm_fiber);
}
static int cfun_lineage(DstArgs args) {
DstFiber *fiber;
DstArray *array;
DST_FIXARITY(args, 1);
DST_ARG_FIBER(fiber, args, 0);
array = dst_array(0);
static int cfun_lineage(JanetArgs args) {
JanetFiber *fiber;
JanetArray *array;
JANET_FIXARITY(args, 1);
JANET_ARG_FIBER(fiber, args, 0);
array = janet_array(0);
while (fiber) {
dst_array_push(array, dst_wrap_fiber(fiber));
janet_array_push(array, janet_wrap_fiber(fiber));
fiber = fiber->child;
}
DST_RETURN_ARRAY(args, array);
JANET_RETURN_ARRAY(args, array);
}
static int cfun_maxstack(DstArgs args) {
DstFiber *fiber;
DST_FIXARITY(args, 1);
DST_ARG_FIBER(fiber, args, 0);
DST_RETURN_INTEGER(args, fiber->maxstack);
static int cfun_maxstack(JanetArgs args) {
JanetFiber *fiber;
JANET_FIXARITY(args, 1);
JANET_ARG_FIBER(fiber, args, 0);
JANET_RETURN_INTEGER(args, fiber->maxstack);
}
static int cfun_setmaxstack(DstArgs args) {
DstFiber *fiber;
static int cfun_setmaxstack(JanetArgs args) {
JanetFiber *fiber;
int32_t maxs;
DST_FIXARITY(args, 2);
DST_ARG_FIBER(fiber, args, 0);
DST_ARG_INTEGER(maxs, args, 1);
JANET_FIXARITY(args, 2);
JANET_ARG_FIBER(fiber, args, 0);
JANET_ARG_INTEGER(maxs, args, 1);
if (maxs < 0) {
DST_THROW(args, "expected positive integer");
JANET_THROW(args, "expected positive integer");
}
fiber->maxstack = maxs;
DST_RETURN_FIBER(args, fiber);
JANET_RETURN_FIBER(args, fiber);
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"fiber.new", cfun_new},
{"fiber.status", cfun_status},
{"fiber.stack", cfun_stack},
@ -466,8 +466,8 @@ static const DstReg cfuns[] = {
};
/* Module entry point */
int dst_lib_fiber(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_fiber(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

38
src/core/fiber.h
View File

@ -20,29 +20,29 @@
* IN THE SOFTWARE.
*/
#ifndef DST_FIBER_H_defined
#define DST_FIBER_H_defined
#ifndef JANET_FIBER_H_defined
#define JANET_FIBER_H_defined
#include <dst/dst.h>
#include <janet/janet.h>
extern DST_THREAD_LOCAL DstFiber *dst_vm_fiber;
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
#define dst_fiber_set_status(f, s) do {\
(f)->flags &= ~DST_FIBER_STATUS_MASK;\
(f)->flags |= (s) << DST_FIBER_STATUS_OFFSET;\
#define janet_fiber_set_status(f, s) do {\
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
(f)->flags |= (s) << JANET_FIBER_STATUS_OFFSET;\
} while (0)
#define dst_stack_frame(s) ((DstStackFrame *)((s) - DST_FRAME_SIZE))
#define dst_fiber_frame(f) dst_stack_frame((f)->data + (f)->frame)
DstFiber *dst_fiber_reset(DstFiber *fiber, DstFunction *callee);
void dst_fiber_setcapacity(DstFiber *fiber, int32_t n);
void dst_fiber_push(DstFiber *fiber, Dst x);
void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y);
void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z);
void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n);
int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
void dst_fiber_cframe(DstFiber *fiber, DstCFunction cfun);
void dst_fiber_popframe(DstFiber *fiber);
#define janet_stack_frame(s) ((JanetStackFrame *)((s) - JANET_FRAME_SIZE))
#define janet_fiber_frame(f) janet_stack_frame((f)->data + (f)->frame)
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee);
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n);
void janet_fiber_push(JanetFiber *fiber, Janet x);
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y);
void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z);
void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n);
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
void janet_fiber_popframe(JanetFiber *fiber);
#endif

346
src/core/gc.c
View File

@ -20,186 +20,186 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "state.h"
#include "symcache.h"
#include "gc.h"
/* GC State */
DST_THREAD_LOCAL void *dst_vm_blocks;
DST_THREAD_LOCAL uint32_t dst_vm_gc_interval;
DST_THREAD_LOCAL uint32_t dst_vm_next_collection;
DST_THREAD_LOCAL int dst_vm_gc_suspend = 0;
JANET_THREAD_LOCAL void *janet_vm_blocks;
JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
/* Roots */
DST_THREAD_LOCAL Dst *dst_vm_roots;
DST_THREAD_LOCAL uint32_t dst_vm_root_count;
DST_THREAD_LOCAL uint32_t dst_vm_root_capacity;
JANET_THREAD_LOCAL Janet *janet_vm_roots;
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
/* Helpers for marking the various gc types */
static void dst_mark_funcenv(DstFuncEnv *env);
static void dst_mark_funcdef(DstFuncDef *def);
static void dst_mark_function(DstFunction *func);
static void dst_mark_array(DstArray *array);
static void dst_mark_table(DstTable *table);
static void dst_mark_struct(const DstKV *st);
static void dst_mark_tuple(const Dst *tuple);
static void dst_mark_buffer(DstBuffer *buffer);
static void dst_mark_string(const uint8_t *str);
static void dst_mark_fiber(DstFiber *fiber);
static void dst_mark_abstract(void *adata);
static void janet_mark_funcenv(JanetFuncEnv *env);
static void janet_mark_funcdef(JanetFuncDef *def);
static void janet_mark_function(JanetFunction *func);
static void janet_mark_array(JanetArray *array);
static void janet_mark_table(JanetTable *table);
static void janet_mark_struct(const JanetKV *st);
static void janet_mark_tuple(const Janet *tuple);
static void janet_mark_buffer(JanetBuffer *buffer);
static void janet_mark_string(const uint8_t *str);
static void janet_mark_fiber(JanetFiber *fiber);
static void janet_mark_abstract(void *adata);
/* Mark a value */
void dst_mark(Dst x) {
switch (dst_type(x)) {
void janet_mark(Janet x) {
switch (janet_type(x)) {
default: break;
case DST_STRING:
case DST_SYMBOL: dst_mark_string(dst_unwrap_string(x)); break;
case DST_FUNCTION: dst_mark_function(dst_unwrap_function(x)); break;
case DST_ARRAY: dst_mark_array(dst_unwrap_array(x)); break;
case DST_TABLE: dst_mark_table(dst_unwrap_table(x)); break;
case DST_STRUCT: dst_mark_struct(dst_unwrap_struct(x)); break;
case DST_TUPLE: dst_mark_tuple(dst_unwrap_tuple(x)); break;
case DST_BUFFER: dst_mark_buffer(dst_unwrap_buffer(x)); break;
case DST_FIBER: dst_mark_fiber(dst_unwrap_fiber(x)); break;
case DST_ABSTRACT: dst_mark_abstract(dst_unwrap_abstract(x)); break;
case JANET_STRING:
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break;
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break;
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break;
case JANET_TABLE: janet_mark_table(janet_unwrap_table(x)); break;
case JANET_STRUCT: janet_mark_struct(janet_unwrap_struct(x)); break;
case JANET_TUPLE: janet_mark_tuple(janet_unwrap_tuple(x)); break;
case JANET_BUFFER: janet_mark_buffer(janet_unwrap_buffer(x)); break;
case JANET_FIBER: janet_mark_fiber(janet_unwrap_fiber(x)); break;
case JANET_ABSTRACT: janet_mark_abstract(janet_unwrap_abstract(x)); break;
}
}
static void dst_mark_string(const uint8_t *str) {
dst_gc_mark(dst_string_raw(str));
static void janet_mark_string(const uint8_t *str) {
janet_gc_mark(janet_string_raw(str));
}
static void dst_mark_buffer(DstBuffer *buffer) {
dst_gc_mark(buffer);
static void janet_mark_buffer(JanetBuffer *buffer) {
janet_gc_mark(buffer);
}
static void dst_mark_abstract(void *adata) {
if (dst_gc_reachable(dst_abstract_header(adata)))
static void janet_mark_abstract(void *adata) {
if (janet_gc_reachable(janet_abstract_header(adata)))
return;
dst_gc_mark(dst_abstract_header(adata));
if (dst_abstract_header(adata)->type->gcmark) {
dst_abstract_header(adata)->type->gcmark(adata, dst_abstract_size(adata));
janet_gc_mark(janet_abstract_header(adata));
if (janet_abstract_header(adata)->type->gcmark) {
janet_abstract_header(adata)->type->gcmark(adata, janet_abstract_size(adata));
}
}
/* Mark a bunch of items in memory */
static void dst_mark_many(const Dst *values, int32_t n) {
const Dst *end = values + n;
static void janet_mark_many(const Janet *values, int32_t n) {
const Janet *end = values + n;
while (values < end) {
dst_mark(*values);
janet_mark(*values);
values += 1;
}
}
/* Mark a bunch of key values items in memory */
static void dst_mark_kvs(const DstKV *kvs, int32_t n) {
const DstKV *end = kvs + n;
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
dst_mark(kvs->key);
dst_mark(kvs->value);
janet_mark(kvs->key);
janet_mark(kvs->value);
kvs++;
}
}
static void dst_mark_array(DstArray *array) {
if (dst_gc_reachable(array))
static void janet_mark_array(JanetArray *array) {
if (janet_gc_reachable(array))
return;
dst_gc_mark(array);
dst_mark_many(array->data, array->count);
janet_gc_mark(array);
janet_mark_many(array->data, array->count);
}
static void dst_mark_table(DstTable *table) {
static void janet_mark_table(JanetTable *table) {
recur: /* Manual tail recursion */
if (dst_gc_reachable(table))
if (janet_gc_reachable(table))
return;
dst_gc_mark(table);
dst_mark_kvs(table->data, table->capacity);
janet_gc_mark(table);
janet_mark_kvs(table->data, table->capacity);
if (table->proto) {
table = table->proto;
goto recur;
}
}
static void dst_mark_struct(const DstKV *st) {
if (dst_gc_reachable(dst_struct_raw(st)))
static void janet_mark_struct(const JanetKV *st) {
if (janet_gc_reachable(janet_struct_raw(st)))
return;
dst_gc_mark(dst_struct_raw(st));
dst_mark_kvs(st, dst_struct_capacity(st));
janet_gc_mark(janet_struct_raw(st));
janet_mark_kvs(st, janet_struct_capacity(st));
}
static void dst_mark_tuple(const Dst *tuple) {
if (dst_gc_reachable(dst_tuple_raw(tuple)))
static void janet_mark_tuple(const Janet *tuple) {
if (janet_gc_reachable(janet_tuple_raw(tuple)))
return;
dst_gc_mark(dst_tuple_raw(tuple));
dst_mark_many(tuple, dst_tuple_length(tuple));
janet_gc_mark(janet_tuple_raw(tuple));
janet_mark_many(tuple, janet_tuple_length(tuple));
}
/* Helper to mark function environments */
static void dst_mark_funcenv(DstFuncEnv *env) {
if (dst_gc_reachable(env))
static void janet_mark_funcenv(JanetFuncEnv *env) {
if (janet_gc_reachable(env))
return;
dst_gc_mark(env);
janet_gc_mark(env);
if (env->offset) {
/* On stack */
dst_mark_fiber(env->as.fiber);
janet_mark_fiber(env->as.fiber);
} else {
/* Not on stack */
dst_mark_many(env->as.values, env->length);
janet_mark_many(env->as.values, env->length);
}
}
/* GC helper to mark a FuncDef */
static void dst_mark_funcdef(DstFuncDef *def) {
static void janet_mark_funcdef(JanetFuncDef *def) {
int32_t i;
if (dst_gc_reachable(def))
if (janet_gc_reachable(def))
return;
dst_gc_mark(def);
dst_mark_many(def->constants, def->constants_length);
janet_gc_mark(def);
janet_mark_many(def->constants, def->constants_length);
for (i = 0; i < def->defs_length; ++i) {
dst_mark_funcdef(def->defs[i]);
janet_mark_funcdef(def->defs[i]);
}
if (def->source)
dst_mark_string(def->source);
janet_mark_string(def->source);
if (def->name)
dst_mark_string(def->name);
janet_mark_string(def->name);
}
static void dst_mark_function(DstFunction *func) {
static void janet_mark_function(JanetFunction *func) {
int32_t i;
int32_t numenvs;
if (dst_gc_reachable(func))
if (janet_gc_reachable(func))
return;
dst_gc_mark(func);
janet_gc_mark(func);
numenvs = func->def->environments_length;
for (i = 0; i < numenvs; ++i) {
dst_mark_funcenv(func->envs[i]);
janet_mark_funcenv(func->envs[i]);
}
dst_mark_funcdef(func->def);
janet_mark_funcdef(func->def);
}
static void dst_mark_fiber(DstFiber *fiber) {
static void janet_mark_fiber(JanetFiber *fiber) {
int32_t i, j;
DstStackFrame *frame;
JanetStackFrame *frame;
recur:
if (dst_gc_reachable(fiber))
if (janet_gc_reachable(fiber))
return;
dst_gc_mark(fiber);
janet_gc_mark(fiber);
if (fiber->root)
dst_mark_function(fiber->root);
janet_mark_function(fiber->root);
i = fiber->frame;
j = fiber->stackstart - DST_FRAME_SIZE;
j = fiber->stackstart - JANET_FRAME_SIZE;
while (i > 0) {
frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE);
frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (NULL != frame->func)
dst_mark_function(frame->func);
janet_mark_function(frame->func);
if (NULL != frame->env)
dst_mark_funcenv(frame->env);
janet_mark_funcenv(frame->env);
/* Mark all values in the stack frame */
dst_mark_many(fiber->data + i, j - i);
j = i - DST_FRAME_SIZE;
janet_mark_many(fiber->data + i, j - i);
j = i - JANET_FRAME_SIZE;
i = frame->prevframe;
}
@ -211,29 +211,29 @@ recur:
}
/* Deinitialize a block of memory */
static void dst_deinit_block(DstGCMemoryHeader *block) {
static void janet_deinit_block(JanetGCMemoryHeader *block) {
void *mem = ((char *)(block + 1));
DstAbstractHeader *h = (DstAbstractHeader *)mem;
switch (block->flags & DST_MEM_TYPEBITS) {
JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
switch (block->flags & JANET_MEM_TYPEBITS) {
default:
case DST_MEMORY_FUNCTION:
case JANET_MEMORY_FUNCTION:
break; /* Do nothing for non gc types */
case DST_MEMORY_SYMBOL:
dst_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
case JANET_MEMORY_SYMBOL:
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
break;
case DST_MEMORY_ARRAY:
dst_array_deinit((DstArray*) mem);
case JANET_MEMORY_ARRAY:
janet_array_deinit((JanetArray*) mem);
break;
case DST_MEMORY_TABLE:
dst_table_deinit((DstTable*) mem);
case JANET_MEMORY_TABLE:
janet_table_deinit((JanetTable*) mem);
break;
case DST_MEMORY_FIBER:
free(((DstFiber *)mem)->data);
case JANET_MEMORY_FIBER:
free(((JanetFiber *)mem)->data);
break;
case DST_MEMORY_BUFFER:
dst_buffer_deinit((DstBuffer *) mem);
case JANET_MEMORY_BUFFER:
janet_buffer_deinit((JanetBuffer *) mem);
break;
case DST_MEMORY_ABSTRACT:
case JANET_MEMORY_ABSTRACT:
if (h->type->gc) {
if (h->type->gc((void *)(h + 1), h->size)) {
/* finalizer failed. try again later? Panic? For now do nothing. */
@ -241,16 +241,16 @@ static void dst_deinit_block(DstGCMemoryHeader *block) {
}
}
break;
case DST_MEMORY_FUNCENV:
case JANET_MEMORY_FUNCENV:
{
DstFuncEnv *env = (DstFuncEnv *)mem;
JanetFuncEnv *env = (JanetFuncEnv *)mem;
if (0 == env->offset)
free(env->as.values);
}
break;
case DST_MEMORY_FUNCDEF:
case JANET_MEMORY_FUNCDEF:
{
DstFuncDef *def = (DstFuncDef *)mem;
JanetFuncDef *def = (JanetFuncDef *)mem;
/* TODO - get this all with one alloc and one free */
free(def->defs);
free(def->environments);
@ -264,21 +264,21 @@ static void dst_deinit_block(DstGCMemoryHeader *block) {
/* Iterate over all allocated memory, and free memory that is not
* marked as reachable. Flip the gc color flag for next sweep. */
void dst_sweep() {
DstGCMemoryHeader *previous = NULL;
DstGCMemoryHeader *current = dst_vm_blocks;
DstGCMemoryHeader *next;
void janet_sweep() {
JanetGCMemoryHeader *previous = NULL;
JanetGCMemoryHeader *current = janet_vm_blocks;
JanetGCMemoryHeader *next;
while (NULL != current) {
next = current->next;
if (current->flags & (DST_MEM_REACHABLE | DST_MEM_DISABLED)) {
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
previous = current;
current->flags &= ~DST_MEM_REACHABLE;
current->flags &= ~JANET_MEM_REACHABLE;
} else {
dst_deinit_block(current);
janet_deinit_block(current);
if (NULL != previous) {
previous->next = next;
} else {
dst_vm_blocks = next;
janet_vm_blocks = next;
}
free(current);
}
@ -287,86 +287,86 @@ void dst_sweep() {
}
/* Allocate some memory that is tracked for garbage collection */
void *dst_gcalloc(enum DstMemoryType type, size_t size) {
DstGCMemoryHeader *mdata;
size_t total = size + sizeof(DstGCMemoryHeader);
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
JanetGCMemoryHeader *mdata;
size_t total = size + sizeof(JanetGCMemoryHeader);
/* Make sure everything is inited */
dst_assert(NULL != dst_vm_cache, "please initialize dst before use");
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
void *mem = malloc(total);
/* Check for bad malloc */
if (NULL == mem) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
mdata = (DstGCMemoryHeader *)mem;
mdata = (JanetGCMemoryHeader *)mem;
/* Configure block */
mdata->flags = type;
/* Prepend block to heap list */
dst_vm_next_collection += (int32_t) size;
mdata->next = dst_vm_blocks;
dst_vm_blocks = mdata;
janet_vm_next_collection += (int32_t) size;
mdata->next = janet_vm_blocks;
janet_vm_blocks = mdata;
return (char *) mem + sizeof(DstGCMemoryHeader);
return (char *) mem + sizeof(JanetGCMemoryHeader);
}
/* Run garbage collection */
void dst_collect(void) {
void janet_collect(void) {
uint32_t i;
if (dst_vm_gc_suspend) return;
for (i = 0; i < dst_vm_root_count; i++)
dst_mark(dst_vm_roots[i]);
dst_sweep();
dst_vm_next_collection = 0;
if (janet_vm_gc_suspend) return;
for (i = 0; i < janet_vm_root_count; i++)
janet_mark(janet_vm_roots[i]);
janet_sweep();
janet_vm_next_collection = 0;
}
/* Add a root value to the GC. This prevents the GC from removing a value
* and all of its children. If gcroot is called on a value n times, unroot
* must also be called n times to remove it as a gc root. */
void dst_gcroot(Dst root) {
uint32_t newcount = dst_vm_root_count + 1;
if (newcount > dst_vm_root_capacity) {
void janet_gcroot(Janet root) {
uint32_t newcount = janet_vm_root_count + 1;
if (newcount > janet_vm_root_capacity) {
uint32_t newcap = 2 * newcount;
dst_vm_roots = realloc(dst_vm_roots, sizeof(Dst) * newcap);
if (NULL == dst_vm_roots) {
DST_OUT_OF_MEMORY;
janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
if (NULL == janet_vm_roots) {
JANET_OUT_OF_MEMORY;
}
dst_vm_root_capacity = newcap;
janet_vm_root_capacity = newcap;
}
dst_vm_roots[dst_vm_root_count] = root;
dst_vm_root_count = newcount;
janet_vm_roots[janet_vm_root_count] = root;
janet_vm_root_count = newcount;
}
/* Identity equality for GC purposes */
static int dst_gc_idequals(Dst lhs, Dst rhs) {
if (dst_type(lhs) != dst_type(rhs))
static int janet_gc_idequals(Janet lhs, Janet rhs) {
if (janet_type(lhs) != janet_type(rhs))
return 0;
switch (dst_type(lhs)) {
case DST_TRUE:
case DST_FALSE:
case DST_NIL:
switch (janet_type(lhs)) {
case JANET_TRUE:
case JANET_FALSE:
case JANET_NIL:
return 1;
case DST_INTEGER:
return dst_unwrap_integer(lhs) == dst_unwrap_integer(rhs);
case DST_REAL:
return dst_unwrap_real(lhs) == dst_unwrap_real(rhs);
case JANET_INTEGER:
return janet_unwrap_integer(lhs) == janet_unwrap_integer(rhs);
case JANET_REAL:
return janet_unwrap_real(lhs) == janet_unwrap_real(rhs);
default:
return dst_unwrap_pointer(lhs) == dst_unwrap_pointer(rhs);
return janet_unwrap_pointer(lhs) == janet_unwrap_pointer(rhs);
}
}
/* Remove a root value from the GC. This allows the gc to potentially reclaim
* a value and all its children. */
int dst_gcunroot(Dst root) {
Dst *vtop = dst_vm_roots + dst_vm_root_count;
Dst *v = dst_vm_roots;
int janet_gcunroot(Janet root) {
Janet *vtop = janet_vm_roots + janet_vm_root_count;
Janet *v = janet_vm_roots;
/* Search from top to bottom as access is most likely LIFO */
for (v = dst_vm_roots; v < vtop; v++) {
if (dst_gc_idequals(root, *v)) {
*v = dst_vm_roots[--dst_vm_root_count];
for (v = janet_vm_roots; v < vtop; v++) {
if (janet_gc_idequals(root, *v)) {
*v = janet_vm_roots[--janet_vm_root_count];
return 1;
}
}
@ -374,14 +374,14 @@ int dst_gcunroot(Dst root) {
}
/* Remove a root value from the GC. This sets the effective reference count to 0. */
int dst_gcunrootall(Dst root) {
Dst *vtop = dst_vm_roots + dst_vm_root_count;
Dst *v = dst_vm_roots;
int janet_gcunrootall(Janet root) {
Janet *vtop = janet_vm_roots + janet_vm_root_count;
Janet *v = janet_vm_roots;
int ret = 0;
/* Search from top to bottom as access is most likely LIFO */
for (v = dst_vm_roots; v < vtop; v++) {
if (dst_gc_idequals(root, *v)) {
*v = dst_vm_roots[--dst_vm_root_count];
for (v = janet_vm_roots; v < vtop; v++) {
if (janet_gc_idequals(root, *v)) {
*v = janet_vm_roots[--janet_vm_root_count];
vtop--;
ret = 1;
}
@ -390,17 +390,17 @@ int dst_gcunrootall(Dst root) {
}
/* Free all allocated memory */
void dst_clear_memory(void) {
DstGCMemoryHeader *current = dst_vm_blocks;
void janet_clear_memory(void) {
JanetGCMemoryHeader *current = janet_vm_blocks;
while (NULL != current) {
dst_deinit_block(current);
DstGCMemoryHeader *next = current->next;
janet_deinit_block(current);
JanetGCMemoryHeader *next = current->next;
free(current);
current = next;
}
dst_vm_blocks = NULL;
janet_vm_blocks = NULL;
}
/* Primitives for suspending GC. */
int dst_gclock(void) { return dst_vm_gc_suspend++; }
void dst_gcunlock(int handle) { dst_vm_gc_suspend = handle; }
int janet_gclock(void) { return janet_vm_gc_suspend++; }
void janet_gcunlock(int handle) { janet_vm_gc_suspend = handle; }

66
src/core/gc.h
View File

@ -20,51 +20,51 @@
* IN THE SOFTWARE.
*/
#ifndef DST_GC_H
#define DST_GC_H
#ifndef JANET_GC_H
#define JANET_GC_H
#include <dst/dst.h>
#include <janet/janet.h>
/* The metadata header associated with an allocated block of memory */
#define dst_gc_header(mem) ((DstGCMemoryHeader *)(mem) - 1)
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
#define DST_MEM_TYPEBITS 0xFF
#define DST_MEM_REACHABLE 0x100
#define DST_MEM_DISABLED 0x200
#define JANET_MEM_TYPEBITS 0xFF
#define JANET_MEM_REACHABLE 0x100
#define JANET_MEM_DISABLED 0x200
#define dst_gc_settype(m, t) ((dst_gc_header(m)->flags |= (0xFF & (t))))
#define dst_gc_type(m) (dst_gc_header(m)->flags & 0xFF)
#define janet_gc_settype(m, t) ((janet_gc_header(m)->flags |= (0xFF & (t))))
#define janet_gc_type(m) (janet_gc_header(m)->flags & 0xFF)
#define dst_gc_mark(m) (dst_gc_header(m)->flags |= DST_MEM_REACHABLE)
#define dst_gc_unmark(m) (dst_gc_header(m)->flags &= ~DST_MEM_COLOR)
#define dst_gc_reachable(m) (dst_gc_header(m)->flags & DST_MEM_REACHABLE)
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
#define janet_gc_unmark(m) (janet_gc_header(m)->flags &= ~JANET_MEM_COLOR)
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
/* Memory header struct. Node of a linked list of memory blocks. */
typedef struct DstGCMemoryHeader DstGCMemoryHeader;
struct DstGCMemoryHeader {
DstGCMemoryHeader *next;
typedef struct JanetGCMemoryHeader JanetGCMemoryHeader;
struct JanetGCMemoryHeader {
JanetGCMemoryHeader *next;
uint32_t flags;
};
/* Memory types for the GC. Different from DstType to include funcenv and funcdef. */
enum DstMemoryType {
DST_MEMORY_NONE,
DST_MEMORY_STRING,
DST_MEMORY_SYMBOL,
DST_MEMORY_ARRAY,
DST_MEMORY_TUPLE,
DST_MEMORY_TABLE,
DST_MEMORY_STRUCT,
DST_MEMORY_FIBER,
DST_MEMORY_BUFFER,
DST_MEMORY_FUNCTION,
DST_MEMORY_ABSTRACT,
DST_MEMORY_FUNCENV,
DST_MEMORY_FUNCDEF
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
enum JanetMemoryType {
JANET_MEMORY_NONE,
JANET_MEMORY_STRING,
JANET_MEMORY_SYMBOL,
JANET_MEMORY_ARRAY,
JANET_MEMORY_TUPLE,
JANET_MEMORY_TABLE,
JANET_MEMORY_STRUCT,
JANET_MEMORY_FIBER,
JANET_MEMORY_BUFFER,
JANET_MEMORY_FUNCTION,
JANET_MEMORY_ABSTRACT,
JANET_MEMORY_FUNCENV,
JANET_MEMORY_FUNCDEF
};
/* To allocate collectable memory, one must calk dst_alloc, initialize the memory,
* and then call when dst_enablegc when it is initailize and reachable by the gc (on the DST stack) */
void *dst_gcalloc(enum DstMemoryType type, size_t size);
/* To allocate collectable memory, one must calk janet_alloc, initialize the memory,
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
#endif

228
src/core/io.c
View File

@ -22,7 +22,7 @@
#define _DEFAULT_SOURCE
#include <stdio.h>
#include <dst/dst.h>
#include <janet/janet.h>
#include <errno.h>
#define IO_WRITE 1
@ -41,11 +41,11 @@ struct IOFile {
int flags;
};
static int dst_io_gc(void *p, size_t len);
static int janet_io_gc(void *p, size_t len);
DstAbstractType dst_io_filetype = {
JanetAbstractType janet_io_filetype = {
":core.file",
dst_io_gc,
janet_io_gc,
NULL
};
@ -85,62 +85,62 @@ static int checkflags(const uint8_t *str, int32_t len) {
}
/* Check file argument */
static IOFile *checkfile(DstArgs args, int32_t n) {
static IOFile *checkfile(JanetArgs args, int32_t n) {
IOFile *iof;
if (n >= args.n) {
*args.ret = dst_cstringv("expected core.file");
*args.ret = janet_cstringv("expected core.file");
return NULL;
}
if (!dst_checktype(args.v[n], DST_ABSTRACT)) {
*args.ret = dst_cstringv("expected core.file");
if (!janet_checktype(args.v[n], JANET_ABSTRACT)) {
*args.ret = janet_cstringv("expected core.file");
return NULL;
}
iof = (IOFile *) dst_unwrap_abstract(args.v[n]);
if (dst_abstract_type(iof) != &dst_io_filetype) {
*args.ret = dst_cstringv("expected core.file");
iof = (IOFile *) janet_unwrap_abstract(args.v[n]);
if (janet_abstract_type(iof) != &janet_io_filetype) {
*args.ret = janet_cstringv("expected core.file");
return NULL;
}
return iof;
}
/* Check buffer argument */
static DstBuffer *checkbuffer(DstArgs args, int32_t n, int optional) {
static JanetBuffer *checkbuffer(JanetArgs args, int32_t n, int optional) {
if (optional && n == args.n) {
return dst_buffer(0);
return janet_buffer(0);
}
if (n >= args.n) {
*args.ret = dst_cstringv("expected buffer");
*args.ret = janet_cstringv("expected buffer");
return NULL;
}
if (!dst_checktype(args.v[n], DST_BUFFER)) {
*args.ret = dst_cstringv("expected buffer");
if (!janet_checktype(args.v[n], JANET_BUFFER)) {
*args.ret = janet_cstringv("expected buffer");
return NULL;
}
return dst_unwrap_abstract(args.v[n]);
return janet_unwrap_abstract(args.v[n]);
}
static Dst makef(FILE *f, int flags) {
IOFile *iof = (IOFile *) dst_abstract(&dst_io_filetype, sizeof(IOFile));
static Janet makef(FILE *f, int flags) {
IOFile *iof = (IOFile *) janet_abstract(&janet_io_filetype, sizeof(IOFile));
iof->file = f;
iof->flags = flags;
return dst_wrap_abstract(iof);
return janet_wrap_abstract(iof);
}
/* Open a process */
static int dst_io_popen(DstArgs args) {
static int janet_io_popen(JanetArgs args) {
const uint8_t *fname, *fmode;
int32_t modelen;
FILE *f;
int flags;
DST_MINARITY(args, 1);
DST_MAXARITY(args, 2);
DST_ARG_STRING(fname, args, 0);
JANET_MINARITY(args, 1);
JANET_MAXARITY(args, 2);
JANET_ARG_STRING(fname, args, 0);
if (args.n == 2) {
if (!dst_checktype(args.v[1], DST_STRING) &&
!dst_checktype(args.v[1], DST_SYMBOL))
DST_THROW(args, "expected string mode");
fmode = dst_unwrap_string(args.v[1]);
modelen = dst_string_length(fmode);
if (!janet_checktype(args.v[1], JANET_STRING) &&
!janet_checktype(args.v[1], JANET_SYMBOL))
JANET_THROW(args, "expected string mode");
fmode = janet_unwrap_string(args.v[1]);
modelen = janet_string_length(fmode);
} else {
fmode = (const uint8_t *)"r";
modelen = 1;
@ -150,37 +150,37 @@ static int dst_io_popen(DstArgs args) {
modelen--;
}
if (modelen != 1 || !(fmode[0] == 'r' || fmode[0] == 'w')) {
DST_THROW(args, "invalid file mode");
JANET_THROW(args, "invalid file mode");
}
flags = (fmode[0] == 'r') ? IO_PIPED | IO_READ : IO_PIPED | IO_WRITE;
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
#define popen _popen
#endif
f = popen((const char *)fname, (const char *)fmode);
if (!f) {
if (errno == EMFILE) {
DST_THROW(args, "too many streams are open");
JANET_THROW(args, "too many streams are open");
}
DST_THROW(args, "could not open file");
JANET_THROW(args, "could not open file");
}
DST_RETURN(args, makef(f, flags));
JANET_RETURN(args, makef(f, flags));
}
/* Open a a file and return a userdata wrapper around the C file API. */
static int dst_io_fopen(DstArgs args) {
static int janet_io_fopen(JanetArgs args) {
const uint8_t *fname, *fmode;
int32_t modelen;
FILE *f;
int flags;
DST_MINARITY(args, 1);
DST_MAXARITY(args, 2);
DST_ARG_STRING(fname, args, 0);
JANET_MINARITY(args, 1);
JANET_MAXARITY(args, 2);
JANET_ARG_STRING(fname, args, 0);
if (args.n == 2) {
if (!dst_checktype(args.v[1], DST_STRING) &&
!dst_checktype(args.v[1], DST_SYMBOL))
DST_THROW(args, "expected string mode");
fmode = dst_unwrap_string(args.v[1]);
modelen = dst_string_length(fmode);
if (!janet_checktype(args.v[1], JANET_STRING) &&
!janet_checktype(args.v[1], JANET_SYMBOL))
JANET_THROW(args, "expected string mode");
fmode = janet_unwrap_string(args.v[1]);
modelen = janet_string_length(fmode);
} else {
fmode = (const uint8_t *)"r";
modelen = 1;
@ -190,18 +190,18 @@ static int dst_io_fopen(DstArgs args) {
modelen--;
}
if ((flags = checkflags(fmode, modelen)) < 0) {
DST_THROW(args, "invalid file mode");
JANET_THROW(args, "invalid file mode");
}
f = fopen((const char *)fname, (const char *)fmode);
DST_RETURN(args, f ? makef(f, flags) : dst_wrap_nil());
JANET_RETURN(args, f ? makef(f, flags) : janet_wrap_nil());
}
/* Read up to n bytes into buffer. Return error string if error. */
static const char *read_chunk(IOFile *iof, DstBuffer *buffer, int32_t nBytesMax) {
static const char *read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
if (!(iof->flags & (IO_READ | IO_UPDATE)))
return "file is not readable";
/* Ensure buffer size */
if (dst_buffer_extra(buffer, nBytesMax))
if (janet_buffer_extra(buffer, nBytesMax))
return "buffer overflow";
size_t ntoread = nBytesMax;
size_t nread = fread((char *)(buffer->data + buffer->count), 1, ntoread, iof->file);
@ -212,17 +212,17 @@ static const char *read_chunk(IOFile *iof, DstBuffer *buffer, int32_t nBytesMax)
}
/* Read a certain number of bytes into memory */
static int dst_io_fread(DstArgs args) {
DstBuffer *b;
static int janet_io_fread(JanetArgs args) {
JanetBuffer *b;
IOFile *iof = checkfile(args, 0);
if (!iof) return 1;
if (iof->flags & IO_CLOSED)
DST_THROW(args, "file is closed");
JANET_THROW(args, "file is closed");
b = checkbuffer(args, 2, 1);
if (!b) return 1;
if (dst_checktype(args.v[1], DST_SYMBOL)) {
const uint8_t *sym = dst_unwrap_symbol(args.v[1]);
if (!dst_cstrcmp(sym, ":all")) {
if (janet_checktype(args.v[1], JANET_SYMBOL)) {
const uint8_t *sym = janet_unwrap_symbol(args.v[1]);
if (!janet_cstrcmp(sym, ":all")) {
/* Read whole file */
int status = fseek(iof->file, 0, SEEK_SET);
if (status) {
@ -231,73 +231,73 @@ static int dst_io_fread(DstArgs args) {
do {
sizeBefore = b->count;
const char *maybeErr = read_chunk(iof, b, 1024);
if (maybeErr) DST_THROW(args, maybeErr);
if (maybeErr) JANET_THROW(args, maybeErr);
} while (sizeBefore < b->count);
} else {
fseek(iof->file, 0, SEEK_END);
long fsize = ftell(iof->file);
fseek(iof->file, 0, SEEK_SET);
if (fsize > INT32_MAX) DST_THROW(args, "buffer overflow");
if (fsize > INT32_MAX) JANET_THROW(args, "buffer overflow");
const char *maybeErr = read_chunk(iof, b, (int32_t) fsize);;
if (maybeErr) DST_THROW(args, maybeErr);
if (maybeErr) JANET_THROW(args, maybeErr);
}
} else if (!dst_cstrcmp(sym, ":line")) {
} else if (!janet_cstrcmp(sym, ":line")) {
for (;;) {
int x = fgetc(iof->file);
if (x != EOF && dst_buffer_push_u8(b, (uint8_t)x))
DST_THROW(args, "buffer overflow");
if (x != EOF && janet_buffer_push_u8(b, (uint8_t)x))
JANET_THROW(args, "buffer overflow");
if (x == EOF || x == '\n') break;
}
} else {
DST_THROW(args, "expected one of :all, :line");
JANET_THROW(args, "expected one of :all, :line");
}
} else if (!dst_checktype(args.v[1], DST_INTEGER)) {
DST_THROW(args, "expected positive integer");
} else if (!janet_checktype(args.v[1], JANET_INTEGER)) {
JANET_THROW(args, "expected positive integer");
} else {
int32_t len = dst_unwrap_integer(args.v[1]);
if (len < 0) DST_THROW(args, "expected positive integer");
int32_t len = janet_unwrap_integer(args.v[1]);
if (len < 0) JANET_THROW(args, "expected positive integer");
const char *maybeErr = read_chunk(iof, b, len);
if (maybeErr) DST_THROW(args, maybeErr);
if (maybeErr) JANET_THROW(args, maybeErr);
}
DST_RETURN(args, dst_wrap_buffer(b));
JANET_RETURN(args, janet_wrap_buffer(b));
}
/* Write bytes to a file */
static int dst_io_fwrite(DstArgs args) {
static int janet_io_fwrite(JanetArgs args) {
int32_t len, i;
const uint8_t *str;
IOFile *iof = checkfile(args, 0);
if (!iof) return 1;
if (iof->flags & IO_CLOSED)
DST_THROW(args, "file is closed");
JANET_THROW(args, "file is closed");
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
DST_THROW(args, "file is not writeable");
JANET_THROW(args, "file is not writeable");
for (i = 1; i < args.n; i++) {
DST_CHECKMANY(args, i, DST_TFLAG_BYTES);
JANET_CHECKMANY(args, i, JANET_TFLAG_BYTES);
}
for (i = 1; i < args.n; i++) {
DST_ARG_BYTES(str, len, args, i);
JANET_ARG_BYTES(str, len, args, i);
if (len) {
if (!fwrite(str, len, 1, iof->file)) DST_THROW(args, "error writing to file");
if (!fwrite(str, len, 1, iof->file)) JANET_THROW(args, "error writing to file");
}
}
DST_RETURN(args, dst_wrap_abstract(iof));
JANET_RETURN(args, janet_wrap_abstract(iof));
}
/* Flush the bytes in the file */
static int dst_io_fflush(DstArgs args) {
static int janet_io_fflush(JanetArgs args) {
IOFile *iof = checkfile(args, 0);
if (!iof) return 1;
if (iof->flags & IO_CLOSED)
DST_THROW(args, "file is closed");
JANET_THROW(args, "file is closed");
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
DST_THROW(args, "file is not flushable");
if (fflush(iof->file)) DST_THROW(args, "could not flush file");
DST_RETURN(args, dst_wrap_abstract(iof));
JANET_THROW(args, "file is not flushable");
if (fflush(iof->file)) JANET_THROW(args, "could not flush file");
JANET_RETURN(args, janet_wrap_abstract(iof));
}
/* Cleanup a file */
static int dst_io_gc(void *p, size_t len) {
static int janet_io_gc(void *p, size_t len) {
(void) len;
IOFile *iof = (IOFile *)p;
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
@ -307,78 +307,78 @@ static int dst_io_gc(void *p, size_t len) {
}
/* Close a file */
static int dst_io_fclose(DstArgs args) {
static int janet_io_fclose(JanetArgs args) {
IOFile *iof = checkfile(args, 0);
if (!iof) return 1;
if (iof->flags & (IO_CLOSED))
DST_THROW(args, "file already closed");
JANET_THROW(args, "file already closed");
if (iof->flags & (IO_NOT_CLOSEABLE))
DST_THROW(args, "file not closable");
JANET_THROW(args, "file not closable");
if (iof->flags & IO_PIPED) {
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
#define pclose _pclose
#endif
if (pclose(iof->file)) DST_THROW(args, "could not close file");
if (pclose(iof->file)) JANET_THROW(args, "could not close file");
} else {
if (fclose(iof->file)) DST_THROW(args, "could not close file");
if (fclose(iof->file)) JANET_THROW(args, "could not close file");
}
iof->flags |= IO_CLOSED;
DST_RETURN(args, dst_wrap_abstract(iof));
JANET_RETURN(args, janet_wrap_abstract(iof));
}
/* Seek a file */
static int dst_io_fseek(DstArgs args) {
static int janet_io_fseek(JanetArgs args) {
long int offset = 0;
int whence = SEEK_CUR;
IOFile *iof = checkfile(args, 0);
if (!iof) return 1;
if (iof->flags & IO_CLOSED)
DST_THROW(args, "file is closed");
JANET_THROW(args, "file is closed");
if (args.n >= 2) {
const uint8_t *whence_sym;
if (!dst_checktype(args.v[1], DST_SYMBOL))
DST_THROW(args, "expected symbol");
whence_sym = dst_unwrap_symbol(args.v[1]);
if (!dst_cstrcmp(whence_sym, ":cur")) {
if (!janet_checktype(args.v[1], JANET_SYMBOL))
JANET_THROW(args, "expected symbol");
whence_sym = janet_unwrap_symbol(args.v[1]);
if (!janet_cstrcmp(whence_sym, ":cur")) {
whence = SEEK_CUR;
} else if (!dst_cstrcmp(whence_sym, ":set")) {
} else if (!janet_cstrcmp(whence_sym, ":set")) {
whence = SEEK_SET;
} else if (!dst_cstrcmp(whence_sym, ":end")) {
} else if (!janet_cstrcmp(whence_sym, ":end")) {
whence = SEEK_END;
} else {
DST_THROW(args, "expected one of :cur, :set, :end");
JANET_THROW(args, "expected one of :cur, :set, :end");
}
if (args.n >= 3) {
if (!dst_checktype(args.v[2], DST_INTEGER))
DST_THROW(args, "expected integer");
offset = dst_unwrap_integer(args.v[2]);
if (!janet_checktype(args.v[2], JANET_INTEGER))
JANET_THROW(args, "expected integer");
offset = janet_unwrap_integer(args.v[2]);
}
}
if (fseek(iof->file, offset, whence))
DST_THROW(args, "error seeking file");
DST_RETURN(args, args.v[0]);
JANET_THROW(args, "error seeking file");
JANET_RETURN(args, args.v[0]);
}
static const DstReg cfuns[] = {
{"file.open", dst_io_fopen},
{"file.close", dst_io_fclose},
{"file.read", dst_io_fread},
{"file.write", dst_io_fwrite},
{"file.flush", dst_io_fflush},
{"file.seek", dst_io_fseek},
{"file.popen", dst_io_popen},
static const JanetReg cfuns[] = {
{"file.open", janet_io_fopen},
{"file.close", janet_io_fclose},
{"file.read", janet_io_fread},
{"file.write", janet_io_fwrite},
{"file.flush", janet_io_fflush},
{"file.seek", janet_io_fseek},
{"file.popen", janet_io_popen},
{NULL, NULL}
};
static void addf(DstTable *env, const char *name, Dst val) {
dst_def(env, name, val);
dst_register(name, val);
static void addf(JanetTable *env, const char *name, Janet val) {
janet_def(env, name, val);
janet_register(name, val);
}
/* Module entry point */
int dst_lib_io(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_io(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
/* stdout */
addf(env, "stdout",

464
src/core/marsh.c
View File

File diff suppressed because it is too large Load Diff

178
src/core/math.c
View File

@ -20,35 +20,35 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include <math.h>
/* Get a random number */
int dst_rand(DstArgs args) {
DST_FIXARITY(args, 0);
int janet_rand(JanetArgs args) {
JANET_FIXARITY(args, 0);
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
DST_RETURN_REAL(args, r);
JANET_RETURN_REAL(args, r);
}
/* Seed the random number generator */
int dst_srand(DstArgs args) {
int janet_srand(JanetArgs args) {
int32_t x = 0;
DST_FIXARITY(args, 1);
DST_ARG_INTEGER(x, args, 0);
JANET_FIXARITY(args, 1);
JANET_ARG_INTEGER(x, args, 0);
srand((unsigned) x);
return 0;
}
/* Convert a number to an integer */
int dst_int(DstArgs args) {
DST_FIXARITY(args, 1);
switch (dst_type(args.v[0])) {
int janet_int(JanetArgs args) {
JANET_FIXARITY(args, 1);
switch (janet_type(args.v[0])) {
default:
DST_THROW(args, "could not convert to integer");
case DST_REAL:
*args.ret = dst_wrap_integer((int32_t) dst_unwrap_real(args.v[0]));
JANET_THROW(args, "could not convert to integer");
case JANET_REAL:
*args.ret = janet_wrap_integer((int32_t) janet_unwrap_real(args.v[0]));
break;
case DST_INTEGER:
case JANET_INTEGER:
*args.ret = args.v[0];
break;
}
@ -56,109 +56,109 @@ int dst_int(DstArgs args) {
}
/* Convert a number to a real number */
int dst_real(DstArgs args) {
DST_FIXARITY(args, 1);
switch (dst_type(args.v[0])) {
int janet_real(JanetArgs args) {
JANET_FIXARITY(args, 1);
switch (janet_type(args.v[0])) {
default:
DST_THROW(args, "could not convert to real");
case DST_REAL:
JANET_THROW(args, "could not convert to real");
case JANET_REAL:
*args.ret = args.v[0];
break;
case DST_INTEGER:
*args.ret = dst_wrap_real((double) dst_unwrap_integer(args.v[0]));
case JANET_INTEGER:
*args.ret = janet_wrap_real((double) janet_unwrap_integer(args.v[0]));
break;
}
return 0;
}
int dst_remainder(DstArgs args) {
DST_FIXARITY(args, 2);
if (dst_checktype(args.v[0], DST_INTEGER) &&
dst_checktype(args.v[1], DST_INTEGER)) {
int janet_remainder(JanetArgs args) {
JANET_FIXARITY(args, 2);
if (janet_checktype(args.v[0], JANET_INTEGER) &&
janet_checktype(args.v[1], JANET_INTEGER)) {
int32_t x, y;
x = dst_unwrap_integer(args.v[0]);
y = dst_unwrap_integer(args.v[1]);
DST_RETURN_INTEGER(args, x % y);
x = janet_unwrap_integer(args.v[0]);
y = janet_unwrap_integer(args.v[1]);
JANET_RETURN_INTEGER(args, x % y);
} else {
double x, y;
DST_ARG_NUMBER(x, args, 0);
DST_ARG_NUMBER(y, args, 1);
DST_RETURN_REAL(args, fmod(x, y));
JANET_ARG_NUMBER(x, args, 0);
JANET_ARG_NUMBER(y, args, 1);
JANET_RETURN_REAL(args, fmod(x, y));
}
}
#define DST_DEFINE_MATHOP(name, fop)\
int dst_##name(DstArgs args) {\
#define JANET_DEFINE_MATHOP(name, fop)\
int janet_##name(JanetArgs args) {\
double x;\
DST_FIXARITY(args, 1);\
DST_ARG_NUMBER(x, args, 0);\
DST_RETURN_REAL(args, fop(x));\
JANET_FIXARITY(args, 1);\
JANET_ARG_NUMBER(x, args, 0);\
JANET_RETURN_REAL(args, fop(x));\
}
DST_DEFINE_MATHOP(acos, acos)
DST_DEFINE_MATHOP(asin, asin)
DST_DEFINE_MATHOP(atan, atan)
DST_DEFINE_MATHOP(cos, cos)
DST_DEFINE_MATHOP(cosh, cosh)
DST_DEFINE_MATHOP(sin, sin)
DST_DEFINE_MATHOP(sinh, sinh)
DST_DEFINE_MATHOP(tan, tan)
DST_DEFINE_MATHOP(tanh, tanh)
DST_DEFINE_MATHOP(exp, exp)
DST_DEFINE_MATHOP(log, log)
DST_DEFINE_MATHOP(log10, log10)
DST_DEFINE_MATHOP(sqrt, sqrt)
DST_DEFINE_MATHOP(ceil, ceil)
DST_DEFINE_MATHOP(fabs, fabs)
DST_DEFINE_MATHOP(floor, floor)
JANET_DEFINE_MATHOP(acos, acos)
JANET_DEFINE_MATHOP(asin, asin)
JANET_DEFINE_MATHOP(atan, atan)
JANET_DEFINE_MATHOP(cos, cos)
JANET_DEFINE_MATHOP(cosh, cosh)
JANET_DEFINE_MATHOP(sin, sin)
JANET_DEFINE_MATHOP(sinh, sinh)
JANET_DEFINE_MATHOP(tan, tan)
JANET_DEFINE_MATHOP(tanh, tanh)
JANET_DEFINE_MATHOP(exp, exp)
JANET_DEFINE_MATHOP(log, log)
JANET_DEFINE_MATHOP(log10, log10)
JANET_DEFINE_MATHOP(sqrt, sqrt)
JANET_DEFINE_MATHOP(ceil, ceil)
JANET_DEFINE_MATHOP(fabs, fabs)
JANET_DEFINE_MATHOP(floor, floor)
#define DST_DEFINE_MATH2OP(name, fop)\
int dst_##name(DstArgs args) {\
#define JANET_DEFINE_MATH2OP(name, fop)\
int janet_##name(JanetArgs args) {\
double lhs, rhs;\
DST_FIXARITY(args, 2);\
DST_ARG_NUMBER(lhs, args, 0);\
DST_ARG_NUMBER(rhs, args, 1);\
DST_RETURN_REAL(args, fop(lhs, rhs));\
JANET_FIXARITY(args, 2);\
JANET_ARG_NUMBER(lhs, args, 0);\
JANET_ARG_NUMBER(rhs, args, 1);\
JANET_RETURN_REAL(args, fop(lhs, rhs));\
}\
DST_DEFINE_MATH2OP(atan2, atan2)
DST_DEFINE_MATH2OP(pow, pow)
JANET_DEFINE_MATH2OP(atan2, atan2)
JANET_DEFINE_MATH2OP(pow, pow)
static int dst_not(DstArgs args) {
DST_FIXARITY(args, 1);
DST_RETURN_BOOLEAN(args, !dst_truthy(args.v[0]));
static int janet_not(JanetArgs args) {
JANET_FIXARITY(args, 1);
JANET_RETURN_BOOLEAN(args, !janet_truthy(args.v[0]));
}
static const DstReg cfuns[] = {
{"%", dst_remainder},
{"not", dst_not},
{"int", dst_int},
{"real", dst_real},
{"math.random", dst_rand},
{"math.seedrandom", dst_srand},
{"math.cos", dst_cos},
{"math.sin", dst_sin},
{"math.tan", dst_tan},
{"math.acos", dst_acos},
{"math.asin", dst_asin},
{"math.atan", dst_atan},
{"math.exp", dst_exp},
{"math.log", dst_log},
{"math.log10", dst_log10},
{"math.sqrt", dst_sqrt},
{"math.floor", dst_floor},
{"math.ceil", dst_ceil},
{"math.pow", dst_pow},
static const JanetReg cfuns[] = {
{"%", janet_remainder},
{"not", janet_not},
{"int", janet_int},
{"real", janet_real},
{"math.random", janet_rand},
{"math.seedrandom", janet_srand},
{"math.cos", janet_cos},
{"math.sin", janet_sin},
{"math.tan", janet_tan},
{"math.acos", janet_acos},
{"math.asin", janet_asin},
{"math.atan", janet_atan},
{"math.exp", janet_exp},
{"math.log", janet_log},
{"math.log10", janet_log10},
{"math.sqrt", janet_sqrt},
{"math.floor", janet_floor},
{"math.ceil", janet_ceil},
{"math.pow", janet_pow},
{NULL, NULL}
};
/* Module entry point */
int dst_lib_math(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_math(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
dst_def(env, "math.pi", dst_wrap_real(3.1415926535897931));
dst_def(env, "math.e", dst_wrap_real(2.7182818284590451));
dst_def(env, "math.inf", dst_wrap_real(INFINITY));
janet_def(env, "math.pi", janet_wrap_real(3.1415926535897931));
janet_def(env, "math.e", janet_wrap_real(2.7182818284590451));
janet_def(env, "math.inf", janet_wrap_real(INFINITY));
return 0;
}

134
src/core/os.c
View File

@ -20,11 +20,11 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include <stdlib.h>
#include <time.h>
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
#include <Windows.h>
#include <direct.h>
#else
@ -34,34 +34,34 @@
#include <stdio.h>
#endif
static int os_which(DstArgs args) {
#ifdef DST_WINDOWS
DST_RETURN_CSYMBOL(args, ":windows");
static int os_which(JanetArgs args) {
#ifdef JANET_WINDOWS
JANET_RETURN_CSYMBOL(args, ":windows");
#elif __APPLE__
DST_RETURN_CSYMBOL(args, ":macos");
JANET_RETURN_CSYMBOL(args, ":macos");
#else
DST_RETURN_CSYMBOL(args, ":posix");
JANET_RETURN_CSYMBOL(args, ":posix");
#endif
}
#ifdef DST_WINDOWS
static int os_execute(DstArgs args) {
DST_MINARITY(args, 1);
DstBuffer *buffer = dst_buffer(10);
#ifdef JANET_WINDOWS
static int os_execute(JanetArgs args) {
JANET_MINARITY(args, 1);
JanetBuffer *buffer = janet_buffer(10);
for (int32_t i = 0; i < args.n; i++) {
const uint8_t *argstring;
DST_ARG_STRING(argstring, args, i);
dst_buffer_push_bytes(buffer, argstring, dst_string_length(argstring));
JANET_ARG_STRING(argstring, args, i);
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
if (i != args.n - 1) {
dst_buffer_push_u8(buffer, ' ');
janet_buffer_push_u8(buffer, ' ');
}
}
dst_buffer_push_u8(buffer, 0);
janet_buffer_push_u8(buffer, 0);
/* Convert to wide chars */
wchar_t *sys_str = malloc(buffer->count * sizeof(wchar_t));
if (NULL == sys_str) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
int nwritten = MultiByteToWideChar(
CP_UTF8,
@ -72,7 +72,7 @@ static int os_execute(DstArgs args) {
buffer->count);
if (nwritten == 0) {
free(sys_str);
DST_THROW(args, "could not create process");
JANET_THROW(args, "could not create process");
}
STARTUPINFO si;
@ -94,7 +94,7 @@ static int os_execute(DstArgs args) {
&si,
&pi)) {
free(sys_str);
DST_THROW(args, "could not create process");
JANET_THROW(args, "could not create process");
}
free(sys_str);
@ -106,17 +106,17 @@ static int os_execute(DstArgs args) {
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
DST_RETURN_INTEGER(args, (int32_t)status);
JANET_RETURN_INTEGER(args, (int32_t)status);
}
#else
static int os_execute(DstArgs args) {
DST_MINARITY(args, 1);
static int os_execute(JanetArgs args) {
JANET_MINARITY(args, 1);
const uint8_t **argv = malloc(sizeof(uint8_t *) * (args.n + 1));
if (NULL == argv) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < args.n; i++) {
DST_ARG_STRING(argv[i], args, i);
JANET_ARG_STRING(argv[i], args, i);
}
argv[args.n] = NULL;
@ -142,37 +142,37 @@ static int os_execute(DstArgs args) {
nanosleep(&waiter, NULL);
}
DST_RETURN_INTEGER(args, status);
JANET_RETURN_INTEGER(args, status);
}
#endif
static int os_shell(DstArgs args) {
int nofirstarg = (args.n < 1 || !dst_checktype(args.v[0], DST_STRING));
static int os_shell(JanetArgs args) {
int nofirstarg = (args.n < 1 || !janet_checktype(args.v[0], JANET_STRING));
const char *cmd = nofirstarg
? NULL
: (const char *) dst_unwrap_string(args.v[0]);
: (const char *) janet_unwrap_string(args.v[0]);
int stat = system(cmd);
DST_RETURN(args, cmd
? dst_wrap_integer(stat)
: dst_wrap_boolean(stat));
JANET_RETURN(args, cmd
? janet_wrap_integer(stat)
: janet_wrap_boolean(stat));
}
static int os_getenv(DstArgs args) {
static int os_getenv(JanetArgs args) {
const uint8_t *k;
DST_FIXARITY(args, 1);
DST_ARG_STRING(k, args, 0);
JANET_FIXARITY(args, 1);
JANET_ARG_STRING(k, args, 0);
const char *cstr = (const char *) k;
const char *res = getenv(cstr);
if (!res) {
DST_RETURN_NIL(args);
JANET_RETURN_NIL(args);
}
DST_RETURN(args, cstr
? dst_cstringv(res)
: dst_wrap_nil());
JANET_RETURN(args, cstr
? janet_cstringv(res)
: janet_wrap_nil());
}
static int os_setenv(DstArgs args) {
#ifdef DST_WINDOWS
static int os_setenv(JanetArgs args) {
#ifdef JANET_WINDOWS
#define SETENV(K,V) _putenv_s(K, V)
#define UNSETENV(K) _putenv_s(K, "")
#else
@ -181,27 +181,27 @@ static int os_setenv(DstArgs args) {
#endif
const uint8_t *k;
const char *ks;
DST_MAXARITY(args, 2);
DST_MINARITY(args, 1);
DST_ARG_STRING(k, args, 0);
JANET_MAXARITY(args, 2);
JANET_MINARITY(args, 1);
JANET_ARG_STRING(k, args, 0);
ks = (const char *) k;
if (args.n == 1 || dst_checktype(args.v[1], DST_NIL)) {
if (args.n == 1 || janet_checktype(args.v[1], JANET_NIL)) {
UNSETENV(ks);
} else {
const uint8_t *v;
DST_ARG_STRING(v, args, 1);
JANET_ARG_STRING(v, args, 1);
const char *vc = (const char *) v;
SETENV(ks, vc);
}
return 0;
}
static int os_exit(DstArgs args) {
DST_MAXARITY(args, 1);
static int os_exit(JanetArgs args) {
JANET_MAXARITY(args, 1);
if (args.n == 0) {
exit(EXIT_SUCCESS);
} else if (dst_checktype(args.v[0], DST_INTEGER)) {
exit(dst_unwrap_integer(args.v[0]));
} else if (janet_checktype(args.v[0], JANET_INTEGER)) {
exit(janet_unwrap_integer(args.v[0]));
} else {
exit(EXIT_FAILURE);
}
@ -209,7 +209,7 @@ static int os_exit(DstArgs args) {
}
/* Clock shim for windows */
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
static int clock_gettime(int x, struct timespec *spec) {
(void) x;
int64_t wintime = 0LL;
@ -224,23 +224,23 @@ static int clock_gettime(int x, struct timespec *spec) {
#define CLOCK_MONOTONIC 0
#endif
static int os_clock(DstArgs args) {
DST_FIXARITY(args, 0);
static int os_clock(JanetArgs args) {
JANET_FIXARITY(args, 0);
struct timespec tv;
if (clock_gettime(CLOCK_MONOTONIC, &tv))
DST_THROW(args, "could not get time");
JANET_THROW(args, "could not get time");
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
DST_RETURN_REAL(args, dtime);
JANET_RETURN_REAL(args, dtime);
}
static int os_sleep(DstArgs args) {
static int os_sleep(JanetArgs args) {
double delay;
DST_FIXARITY(args, 1);
DST_ARG_NUMBER(delay, args, 0);
JANET_FIXARITY(args, 1);
JANET_ARG_NUMBER(delay, args, 0);
if (delay < 0) {
DST_THROW(args, "invalid argument to sleep");
JANET_THROW(args, "invalid argument to sleep");
}
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
Sleep((DWORD) (delay * 1000));
#else
struct timespec ts;
@ -253,22 +253,22 @@ static int os_sleep(DstArgs args) {
return 0;
}
static int os_cwd(DstArgs args) {
DST_FIXARITY(args, 0);
static int os_cwd(JanetArgs args) {
JANET_FIXARITY(args, 0);
char buf[FILENAME_MAX];
char *ptr;
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
ptr = _getcwd(buf, FILENAME_MAX);
#else
ptr = getcwd(buf, FILENAME_MAX);
#endif
if (NULL == ptr) {
DST_THROW(args, "could not get current directory");
JANET_THROW(args, "could not get current directory");
}
DST_RETURN_CSTRING(args, ptr);
JANET_RETURN_CSTRING(args, ptr);
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"os.which", os_which},
{"os.execute", os_execute},
{"os.shell", os_shell},
@ -282,8 +282,8 @@ static const DstReg cfuns[] = {
};
/* Module entry point */
int dst_lib_os(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_os(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

350
src/core/parse.c
View File

@ -20,14 +20,14 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
/* Quote a value */
static Dst quote(Dst x) {
Dst *t = dst_tuple_begin(2);
t[0] = dst_csymbolv("quote");
static Janet quote(Janet x) {
Janet *t = janet_tuple_begin(2);
t[0] = janet_csymbolv("quote");
t[1] = x;
return dst_wrap_tuple(dst_tuple_end(t));
return janet_wrap_tuple(janet_tuple_end(t));
}
/* Check if a character is whitespace */
@ -107,8 +107,8 @@ static int to_hex(uint8_t c) {
}
}
typedef int (*Consumer)(DstParser *p, DstParseState *state, uint8_t c);
struct DstParseState {
typedef int (*Consumer)(JanetParser *p, JanetParseState *state, uint8_t c);
struct JanetParseState {
int32_t qcount;
int32_t argn;
int flags;
@ -119,7 +119,7 @@ struct DstParseState {
/* Define a stack on the main parser struct */
#define DEF_PARSER_STACK(NAME, T, STACK, STACKCOUNT, STACKCAP) \
static void NAME(DstParser *p, T x) { \
static void NAME(JanetParser *p, T x) { \
size_t oldcount = p->STACKCOUNT; \
size_t newcount = oldcount + 1; \
if (newcount > p->STACKCAP) { \
@ -127,7 +127,7 @@ static void NAME(DstParser *p, T x) { \
size_t newcap = 2 * newcount; \
next = realloc(p->STACK, sizeof(T) * newcap); \
if (NULL == next) { \
DST_OUT_OF_MEMORY; \
JANET_OUT_OF_MEMORY; \
} \
p->STACK = next; \
p->STACKCAP = newcap; \
@ -137,8 +137,8 @@ static void NAME(DstParser *p, T x) { \
}
DEF_PARSER_STACK(push_buf, uint8_t, buf, bufcount, bufcap)
DEF_PARSER_STACK(push_arg, Dst, args, argcount, argcap)
DEF_PARSER_STACK(_pushstate, DstParseState, states, statecount, statecap)
DEF_PARSER_STACK(push_arg, Janet, args, argcount, argcap)
DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
#undef DEF_PARSER_STACK
@ -150,8 +150,8 @@ DEF_PARSER_STACK(_pushstate, DstParseState, states, statecount, statecap)
#define PFLAG_STRING 32
#define PFLAG_LONGSTRING 64
static void pushstate(DstParser *p, Consumer consumer, int flags) {
DstParseState s;
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
JanetParseState s;
s.qcount = 0;
s.argn = 0;
s.flags = flags;
@ -161,26 +161,26 @@ static void pushstate(DstParser *p, Consumer consumer, int flags) {
_pushstate(p, s);
}
static void popstate(DstParser *p, Dst val) {
DstParseState top = p->states[--p->statecount];
DstParseState *newtop = p->states + p->statecount - 1;
static void popstate(JanetParser *p, Janet val) {
JanetParseState top = p->states[--p->statecount];
JanetParseState *newtop = p->states + p->statecount - 1;
if (newtop->flags & PFLAG_CONTAINER) {
int32_t i, len;
len = newtop->qcount;
/* Quote the returned value qcount times */
for (i = 0; i < len; i++) {
if (dst_checktype(val, DST_TUPLE)) {
dst_tuple_sm_line(dst_unwrap_tuple(val)) = (int32_t) top.start_line;
dst_tuple_sm_col(dst_unwrap_tuple(val)) = (int32_t) top.start_col;
if (janet_checktype(val, JANET_TUPLE)) {
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.start_line;
janet_tuple_sm_col(janet_unwrap_tuple(val)) = (int32_t) top.start_col;
}
val = quote(val);
}
newtop->qcount = 0;
/* Ast wrap */
if (dst_checktype(val, DST_TUPLE)) {
dst_tuple_sm_line(dst_unwrap_tuple(val)) = (int32_t) top.start_line;
dst_tuple_sm_col(dst_unwrap_tuple(val)) = (int32_t) top.start_col;
if (janet_checktype(val, JANET_TUPLE)) {
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.start_line;
janet_tuple_sm_col(janet_unwrap_tuple(val)) = (int32_t) top.start_col;
}
newtop->argn++;
@ -205,9 +205,9 @@ static int checkescape(uint8_t c) {
}
/* Forward declare */
static int stringchar(DstParser *p, DstParseState *state, uint8_t c);
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
static int escapeh(DstParser *p, DstParseState *state, uint8_t c) {
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
int digit = to_hex(c);
if (digit < 0) {
p->error = "invalid hex digit in hex escape";
@ -223,7 +223,7 @@ static int escapeh(DstParser *p, DstParseState *state, uint8_t c) {
return 1;
}
static int escape1(DstParser *p, DstParseState *state, uint8_t c) {
static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
int e = checkescape(c);
if (e < 0) {
p->error = "invalid string escape sequence";
@ -240,21 +240,21 @@ static int escape1(DstParser *p, DstParseState *state, uint8_t c) {
return 1;
}
static int stringend(DstParser *p, DstParseState *state) {
Dst ret;
static int stringend(JanetParser *p, JanetParseState *state) {
Janet ret;
if (state->flags & PFLAG_BUFFER) {
DstBuffer *b = dst_buffer((int32_t)p->bufcount);
dst_buffer_push_bytes(b, p->buf, (int32_t)p->bufcount);
ret = dst_wrap_buffer(b);
JanetBuffer *b = janet_buffer((int32_t)p->bufcount);
janet_buffer_push_bytes(b, p->buf, (int32_t)p->bufcount);
ret = janet_wrap_buffer(b);
} else {
ret = dst_wrap_string(dst_string(p->buf, (int32_t)p->bufcount));
ret = janet_wrap_string(janet_string(p->buf, (int32_t)p->bufcount));
}
p->bufcount = 0;
popstate(p, ret);
return 1;
}
static int stringchar(DstParser *p, DstParseState *state, uint8_t c) {
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c) {
/* Enter escape */
if (c == '\\') {
state->consumer = escape1;
@ -282,8 +282,8 @@ static int check_str_const(const char *cstr, const uint8_t *str, int32_t len) {
return (cstr[index] == '\0') ? 0 : -1;
}
static int tokenchar(DstParser *p, DstParseState *state, uint8_t c) {
Dst numcheck, ret;
static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
Janet numcheck, ret;
int32_t blen;
if (is_symbol_char(c)) {
push_buf(p, (uint8_t) c);
@ -292,15 +292,15 @@ static int tokenchar(DstParser *p, DstParseState *state, uint8_t c) {
}
/* Token finished */
blen = (int32_t) p->bufcount;
numcheck = dst_scan_number(p->buf, blen);
if (!dst_checktype(numcheck, DST_NIL)) {
numcheck = janet_scan_number(p->buf, blen);
if (!janet_checktype(numcheck, JANET_NIL)) {
ret = numcheck;
} else if (!check_str_const("nil", p->buf, blen)) {
ret = dst_wrap_nil();
ret = janet_wrap_nil();
} else if (!check_str_const("false", p->buf, blen)) {
ret = dst_wrap_false();
ret = janet_wrap_false();
} else if (!check_str_const("true", p->buf, blen)) {
ret = dst_wrap_true();
ret = janet_wrap_true();
} else if (p->buf) {
if (p->buf[0] >= '0' && p->buf[0] <= '9') {
p->error = "symbol literal cannot start with a digit";
@ -312,7 +312,7 @@ static int tokenchar(DstParser *p, DstParseState *state, uint8_t c) {
p->error = "invalid utf-8 in symbol";
return 0;
}
ret = dst_symbolv(p->buf, blen);
ret = janet_symbolv(p->buf, blen);
}
} else {
p->error = "empty symbol invalid";
@ -323,81 +323,81 @@ static int tokenchar(DstParser *p, DstParseState *state, uint8_t c) {
return 0;
}
static int comment(DstParser *p, DstParseState *state, uint8_t c) {
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state;
if (c == '\n') p->statecount--;
return 1;
}
/* Forward declaration */
static int root(DstParser *p, DstParseState *state, uint8_t c);
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
static int dotuple(DstParser *p, DstParseState *state, uint8_t c) {
static int dotuple(JanetParser *p, JanetParseState *state, uint8_t c) {
if (state->flags & PFLAG_SQRBRACKETS
? c == ']'
: c == ')') {
int32_t i;
Dst *ret = dst_tuple_begin(state->argn);
Janet *ret = janet_tuple_begin(state->argn);
for (i = state->argn - 1; i >= 0; i--) {
ret[i] = p->args[--p->argcount];
}
popstate(p, dst_wrap_tuple(dst_tuple_end(ret)));
popstate(p, janet_wrap_tuple(janet_tuple_end(ret)));
return 1;
}
return root(p, state, c);
}
static int doarray(DstParser *p, DstParseState *state, uint8_t c) {
static int doarray(JanetParser *p, JanetParseState *state, uint8_t c) {
if (state->flags & PFLAG_SQRBRACKETS
? c == ']'
: c == ')') {
int32_t i;
DstArray *array = dst_array(state->argn);
JanetArray *array = janet_array(state->argn);
for (i = state->argn - 1; i >= 0; i--) {
array->data[i] = p->args[--p->argcount];
}
array->count = state->argn;
popstate(p, dst_wrap_array(array));
popstate(p, janet_wrap_array(array));
return 1;
}
return root(p, state, c);
}
static int dostruct(DstParser *p, DstParseState *state, uint8_t c) {
static int dostruct(JanetParser *p, JanetParseState *state, uint8_t c) {
if (c == '}') {
int32_t i;
DstKV *st;
JanetKV *st;
if (state->argn & 1) {
p->error = "struct literal expects even number of arguments";
return 1;
}
st = dst_struct_begin(state->argn >> 1);
st = janet_struct_begin(state->argn >> 1);
for (i = state->argn; i > 0; i -= 2) {
Dst value = p->args[--p->argcount];
Dst key = p->args[--p->argcount];
dst_struct_put(st, key, value);
Janet value = p->args[--p->argcount];
Janet key = p->args[--p->argcount];
janet_struct_put(st, key, value);
}
popstate(p, dst_wrap_struct(dst_struct_end(st)));
popstate(p, janet_wrap_struct(janet_struct_end(st)));
return 1;
}
return root(p, state, c);
}
static int dotable(DstParser *p, DstParseState *state, uint8_t c) {
static int dotable(JanetParser *p, JanetParseState *state, uint8_t c) {
if (c == '}') {
int32_t i;
DstTable *table;
JanetTable *table;
if (state->argn & 1) {
p->error = "table literal expects even number of arguments";
return 1;
}
table = dst_table(state->argn >> 1);
table = janet_table(state->argn >> 1);
for (i = state->argn; i > 0; i -= 2) {
Dst value = p->args[--p->argcount];
Dst key = p->args[--p->argcount];
dst_table_put(table, key, value);
Janet value = p->args[--p->argcount];
Janet key = p->args[--p->argcount];
janet_table_put(table, key, value);
}
popstate(p, dst_wrap_table(table));
popstate(p, janet_wrap_table(table));
return 1;
}
return root(p, state, c);
@ -405,7 +405,7 @@ static int dotable(DstParser *p, DstParseState *state, uint8_t c) {
#define PFLAG_INSTRING 128
#define PFLAG_END_CANDIDATE 256
static int longstring(DstParser *p, DstParseState *state, uint8_t c) {
static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
if (state->flags & PFLAG_INSTRING) {
/* We are inside the long string */
if (c == '`') {
@ -447,7 +447,7 @@ static int longstring(DstParser *p, DstParseState *state, uint8_t c) {
}
}
static int ampersand(DstParser *p, DstParseState *state, uint8_t c) {
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state;
p->statecount--;
switch (c) {
@ -475,7 +475,7 @@ static int ampersand(DstParser *p, DstParseState *state, uint8_t c) {
}
/* The root state of the parser */
static int root(DstParser *p, DstParseState *state, uint8_t c) {
static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
switch (c) {
default:
if (is_whitespace(c)) return 1;
@ -517,7 +517,7 @@ static int root(DstParser *p, DstParseState *state, uint8_t c) {
}
}
int dst_parser_consume(DstParser *parser, uint8_t c) {
int janet_parser_consume(JanetParser *parser, uint8_t c) {
int consumed = 0;
if (parser->error) return 0;
if (c == '\n') {
@ -527,42 +527,42 @@ int dst_parser_consume(DstParser *parser, uint8_t c) {
parser->col++;
}
while (!consumed && !parser->error) {
DstParseState *state = parser->states + parser->statecount - 1;
JanetParseState *state = parser->states + parser->statecount - 1;
consumed = state->consumer(parser, state, c);
}
parser->lookback = c;
return 1;
}
enum DstParserStatus dst_parser_status(DstParser *parser) {
if (parser->error) return DST_PARSE_ERROR;
if (parser->statecount > 1) return DST_PARSE_PENDING;
if (parser->argcount) return DST_PARSE_FULL;
return DST_PARSE_ROOT;
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
if (parser->error) return JANET_PARSE_ERROR;
if (parser->statecount > 1) return JANET_PARSE_PENDING;
if (parser->argcount) return JANET_PARSE_FULL;
return JANET_PARSE_ROOT;
}
void dst_parser_flush(DstParser *parser) {
void janet_parser_flush(JanetParser *parser) {
parser->argcount = 0;
parser->statecount = 1;
parser->bufcount = 0;
}
const char *dst_parser_error(DstParser *parser) {
enum DstParserStatus status = dst_parser_status(parser);
if (status == DST_PARSE_ERROR) {
const char *janet_parser_error(JanetParser *parser) {
enum JanetParserStatus status = janet_parser_status(parser);
if (status == JANET_PARSE_ERROR) {
const char *e = parser->error;
parser->error = NULL;
dst_parser_flush(parser);
janet_parser_flush(parser);
return e;
}
return NULL;
}
Dst dst_parser_produce(DstParser *parser) {
Dst ret;
Janet janet_parser_produce(JanetParser *parser) {
Janet ret;
size_t i;
enum DstParserStatus status = dst_parser_status(parser);
if (status != DST_PARSE_FULL) return dst_wrap_nil();
enum JanetParserStatus status = janet_parser_status(parser);
if (status != JANET_PARSE_FULL) return janet_wrap_nil();
ret = parser->args[0];
for (i = 1; i < parser->argcount; i++) {
parser->args[i - 1] = parser->args[i];
@ -571,7 +571,7 @@ Dst dst_parser_produce(DstParser *parser) {
return ret;
}
void dst_parser_init(DstParser *parser) {
void janet_parser_init(JanetParser *parser) {
parser->args = NULL;
parser->states = NULL;
parser->buf = NULL;
@ -589,7 +589,7 @@ void dst_parser_init(DstParser *parser) {
pushstate(parser, root, PFLAG_CONTAINER);
}
void dst_parser_deinit(DstParser *parser) {
void janet_parser_deinit(JanetParser *parser) {
free(parser->args);
free(parser->buf);
free(parser->states);
@ -599,159 +599,159 @@ void dst_parser_deinit(DstParser *parser) {
static int parsermark(void *p, size_t size) {
size_t i;
DstParser *parser = (DstParser *)p;
JanetParser *parser = (JanetParser *)p;
(void) size;
for (i = 0; i < parser->argcount; i++) {
dst_mark(parser->args[i]);
janet_mark(parser->args[i]);
}
return 0;
}
static int parsergc(void *p, size_t size) {
DstParser *parser = (DstParser *)p;
JanetParser *parser = (JanetParser *)p;
(void) size;
dst_parser_deinit(parser);
janet_parser_deinit(parser);
return 0;
}
static DstAbstractType dst_parse_parsertype = {
static JanetAbstractType janet_parse_parsertype = {
":core.parser",
parsergc,
parsermark
};
DstParser *dst_check_parser(Dst x) {
if (!dst_checktype(x, DST_ABSTRACT))
JanetParser *janet_check_parser(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT))
return NULL;
void *abstract = dst_unwrap_abstract(x);
if (dst_abstract_type(abstract) != &dst_parse_parsertype)
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &janet_parse_parsertype)
return NULL;
return (DstParser *)abstract;
return (JanetParser *)abstract;
}
/* C Function parser */
static int cfun_parser(DstArgs args) {
DST_FIXARITY(args, 0);
DstParser *p = dst_abstract(&dst_parse_parsertype, sizeof(DstParser));
dst_parser_init(p);
DST_RETURN_ABSTRACT(args, p);
static int cfun_parser(JanetArgs args) {
JANET_FIXARITY(args, 0);
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
janet_parser_init(p);
JANET_RETURN_ABSTRACT(args, p);
}
static int cfun_consume(DstArgs args) {
static int cfun_consume(JanetArgs args) {
const uint8_t *bytes;
int32_t len;
DstParser *p;
JanetParser *p;
int32_t i;
DST_FIXARITY(args, 2);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
DST_ARG_BYTES(bytes, len, args, 1);
JANET_FIXARITY(args, 2);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
JANET_ARG_BYTES(bytes, len, args, 1);
for (i = 0; i < len; i++) {
dst_parser_consume(p, bytes[i]);
switch (dst_parser_status(p)) {
case DST_PARSE_ROOT:
case DST_PARSE_PENDING:
janet_parser_consume(p, bytes[i]);
switch (janet_parser_status(p)) {
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
break;
default:
{
DstBuffer *b = dst_buffer(len - i);
dst_buffer_push_bytes(b, bytes + i + 1, len - i - 1);
DST_RETURN_BUFFER(args, b);
JanetBuffer *b = janet_buffer(len - i);
janet_buffer_push_bytes(b, bytes + i + 1, len - i - 1);
JANET_RETURN_BUFFER(args, b);
}
}
}
DST_RETURN(args, dst_wrap_nil());
JANET_RETURN(args, janet_wrap_nil());
}
static int cfun_byte(DstArgs args) {
static int cfun_byte(JanetArgs args) {
int32_t i;
DstParser *p;
DST_FIXARITY(args, 2);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
DST_ARG_INTEGER(i, args, 1);
dst_parser_consume(p, 0xFF & i);
DST_RETURN(args, args.v[0]);
JanetParser *p;
JANET_FIXARITY(args, 2);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
JANET_ARG_INTEGER(i, args, 1);
janet_parser_consume(p, 0xFF & i);
JANET_RETURN(args, args.v[0]);
}
static int cfun_status(DstArgs args) {
static int cfun_status(JanetArgs args) {
const char *stat = NULL;
DstParser *p;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
switch (dst_parser_status(p)) {
case DST_PARSE_FULL:
JanetParser *p;
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
switch (janet_parser_status(p)) {
case JANET_PARSE_FULL:
stat = ":full";
break;
case DST_PARSE_PENDING:
case JANET_PARSE_PENDING:
stat = ":pending";
break;
case DST_PARSE_ERROR:
case JANET_PARSE_ERROR:
stat = ":error";
break;
case DST_PARSE_ROOT:
case JANET_PARSE_ROOT:
stat = ":root";
break;
}
DST_RETURN_CSYMBOL(args, stat);
JANET_RETURN_CSYMBOL(args, stat);
}
static int cfun_error(DstArgs args) {
static int cfun_error(JanetArgs args) {
const char *err;
DstParser *p;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
err = dst_parser_error(p);
JanetParser *p;
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
err = janet_parser_error(p);
if (err) {
DST_RETURN_CSYMBOL(args, err);
JANET_RETURN_CSYMBOL(args, err);
} else {
DST_RETURN_NIL(args);
JANET_RETURN_NIL(args);
}
}
static int cfun_produce(DstArgs args) {
Dst val;
DstParser *p;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
val = dst_parser_produce(p);
DST_RETURN(args, val);
static int cfun_produce(JanetArgs args) {
Janet val;
JanetParser *p;
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
val = janet_parser_produce(p);
JANET_RETURN(args, val);
}
static int cfun_flush(DstArgs args) {
DstParser *p;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
dst_parser_flush(p);
DST_RETURN(args, args.v[0]);
static int cfun_flush(JanetArgs args) {
JanetParser *p;
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
janet_parser_flush(p);
JANET_RETURN(args, args.v[0]);
}
static int cfun_where(DstArgs args) {
DstParser *p;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
Dst *tup = dst_tuple_begin(2);
tup[0] = dst_wrap_integer((int32_t)p->line);
tup[1] = dst_wrap_integer((int32_t)p->col);
DST_RETURN_TUPLE(args, dst_tuple_end(tup));
static int cfun_where(JanetArgs args) {
JanetParser *p;
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
Janet *tup = janet_tuple_begin(2);
tup[0] = janet_wrap_integer((int32_t)p->line);
tup[1] = janet_wrap_integer((int32_t)p->col);
JANET_RETURN_TUPLE(args, janet_tuple_end(tup));
}
static int cfun_state(DstArgs args) {
static int cfun_state(JanetArgs args) {
size_t i;
const uint8_t *str;
size_t oldcount;
DstParser *p;
DST_FIXARITY(args, 1);
DST_CHECKABSTRACT(args, 0, &dst_parse_parsertype);
p = (DstParser *) dst_unwrap_abstract(args.v[0]);
JanetParser *p;
JANET_FIXARITY(args, 1);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
oldcount = p->bufcount;
for (i = 0; i < p->statecount; i++) {
DstParseState *s = p->states + i;
JanetParseState *s = p->states + i;
if (s->flags & PFLAG_PARENS) {
push_buf(p, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
@ -767,12 +767,12 @@ static int cfun_state(DstArgs args) {
}
}
}
str = dst_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
p->bufcount = oldcount;
DST_RETURN_STRING(args, str);
JANET_RETURN_STRING(args, str);
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"parser.new", cfun_parser},
{"parser.produce", cfun_produce},
{"parser.consume", cfun_consume},
@ -786,8 +786,8 @@ static const DstReg cfuns[] = {
};
/* Load the library */
int dst_lib_parse(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_parse(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

44
src/core/regalloc.c
View File

@ -20,10 +20,10 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "regalloc.h"
void dstc_regalloc_init(DstcRegisterAllocator *ra) {
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
ra->chunks = NULL;
ra->count = 0;
ra->capacity = 0;
@ -31,7 +31,7 @@ void dstc_regalloc_init(DstcRegisterAllocator *ra) {
ra->regtemps = 0;
}
void dstc_regalloc_deinit(DstcRegisterAllocator *ra) {
void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) {
free(ra->chunks);
}
@ -58,7 +58,7 @@ static int32_t count_trailing_ones(uint32_t x) {
#define nbits(N) (ithbit(N) - 1)
/* Copy a regsiter allocator */
void dstc_regalloc_clone(DstcRegisterAllocator *dest, DstcRegisterAllocator *src) {
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src) {
size_t size;
dest->count = src->count;
dest->capacity = src->capacity;
@ -67,13 +67,13 @@ void dstc_regalloc_clone(DstcRegisterAllocator *dest, DstcRegisterAllocator *src
dest->chunks = malloc(size);
dest->regtemps = 0;
if (!dest->chunks) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
memcpy(dest->chunks, src->chunks, size);
}
/* Allocate one more chunk in chunks */
static void pushchunk(DstcRegisterAllocator *ra) {
static void pushchunk(JanetcRegisterAllocator *ra) {
/* Registers 240-255 are always allocated (reserved) */
uint32_t chunk = ra->count == 7 ? 0xFFFF0000 : 0;
int32_t newcount = ra->count + 1;
@ -81,7 +81,7 @@ static void pushchunk(DstcRegisterAllocator *ra) {
int32_t newcapacity = newcount * 2;
ra->chunks = realloc(ra->chunks, newcapacity * sizeof(uint32_t));
if (!ra->chunks) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
ra->capacity = newcapacity;
}
@ -90,7 +90,7 @@ static void pushchunk(DstcRegisterAllocator *ra) {
}
/* Reallocate a given register */
void dstc_regalloc_touch(DstcRegisterAllocator *ra, int32_t reg) {
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg) {
int32_t chunk = reg >> 5;
int32_t bit = reg & 0x1F;
while (chunk >= ra->count) pushchunk(ra);
@ -98,7 +98,7 @@ void dstc_regalloc_touch(DstcRegisterAllocator *ra, int32_t reg) {
}
/* Allocate one register. */
int32_t dstc_regalloc_1(DstcRegisterAllocator *ra) {
int32_t janetc_regalloc_1(JanetcRegisterAllocator *ra) {
/* Get the nth bit in the array */
int32_t bit, chunk, nchunks, reg;
bit = -1;
@ -125,22 +125,22 @@ int32_t dstc_regalloc_1(DstcRegisterAllocator *ra) {
/* Free a register. The register must have been previously allocated
* without being freed. */
void dstc_regalloc_free(DstcRegisterAllocator *ra, int32_t reg) {
void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
int32_t chunk = reg >> 5;
int32_t bit = reg & 0x1F;
ra->chunks[chunk] &= ~ithbit(bit);
}
/* Get a register that will fit in 8 bits (< 256). Do not call this
* twice with the same value of nth without calling dstc_regalloc_free
* twice with the same value of nth without calling janetc_regalloc_free
* on the returned register before. */
int32_t dstc_regalloc_temp(DstcRegisterAllocator *ra, DstcRegisterTemp nth) {
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
int32_t oldmax = ra->max;
if (ra->regtemps & (1 << nth)) {
dst_exit("regtemp already allocated");
janet_exit("regtemp already allocated");
}
ra->regtemps |= 1 << nth;
int32_t reg = dstc_regalloc_1(ra);
int32_t reg = janetc_regalloc_1(ra);
if (reg > 0xFF) {
reg = 0xF0 + nth;
ra->max = (reg > oldmax) ? reg : oldmax;
@ -148,16 +148,16 @@ int32_t dstc_regalloc_temp(DstcRegisterAllocator *ra, DstcRegisterTemp nth) {
return reg;
}
void dstc_regalloc_freetemp(DstcRegisterAllocator *ra, int32_t reg, DstcRegisterTemp nth) {
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth) {
ra->regtemps &= ~(1 << nth);
if (reg < 0xF0)
dstc_regalloc_free(ra, reg);
janetc_regalloc_free(ra, reg);
}
/* Disable multi-slot allocation for now. */
/*
static int32_t checkrange(DstcRegisterAllocator *ra, int32_t start, int32_t end) {
static int32_t checkrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
int32_t startchunk = start / 32;
int32_t endchunk = end / 32;
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
@ -179,7 +179,7 @@ static int32_t checkrange(DstcRegisterAllocator *ra, int32_t start, int32_t end)
return -1;
}
static void markrange(DstcRegisterAllocator *ra, int32_t start, int32_t end) {
static void markrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
int32_t startchunk = start / 32;
int32_t endchunk = end / 32;
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
@ -192,7 +192,7 @@ static void markrange(DstcRegisterAllocator *ra, int32_t start, int32_t end) {
}
}
void dstc_regalloc_freerange(DstcRegisterAllocator *ra, int32_t start, int32_t n) {
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t start, int32_t n) {
int32_t end = start + n - 1;
int32_t startchunk = start / 32;
int32_t endchunk = end / 32;
@ -206,7 +206,7 @@ void dstc_regalloc_freerange(DstcRegisterAllocator *ra, int32_t start, int32_t n
}
}
int32_t dstc_regalloc_n(DstcRegisterAllocator *ra, int32_t n) {
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n) {
int32_t start = 0, end = 0, next = 0;
while (next >= 0) {
start = next;
@ -219,12 +219,12 @@ int32_t dstc_regalloc_n(DstcRegisterAllocator *ra, int32_t n) {
return start;
}
int32_t dstc_regalloc_call(DstcRegisterAllocator *ra, int32_t callee, int32_t nargs) {
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs) {
if (checkrange(ra, callee, callee + nargs) < 0) {
markrange(ra, callee + 1, callee + nargs);
return callee;
}
return dstc_regalloc_n(ra, nargs + 1);
return janetc_regalloc_n(ra, nargs + 1);
}
*/

46
src/core/regalloc.h
View File

@ -22,22 +22,22 @@
/* Implements a simple first fit register allocator for the compiler. */
#ifndef DST_REGALLOC_H
#define DST_REGALLOC_H
#ifndef JANET_REGALLOC_H
#define JANET_REGALLOC_H
#include <stdint.h>
/* Placeholder for allocating temporary registers */
typedef enum {
DSTC_REGTEMP_0,
DSTC_REGTEMP_1,
DSTC_REGTEMP_2,
DSTC_REGTEMP_3,
DSTC_REGTEMP_4,
DSTC_REGTEMP_5,
DSTC_REGTEMP_6,
DSTC_REGTEMP_7
} DstcRegisterTemp;
JANETC_REGTEMP_0,
JANETC_REGTEMP_1,
JANETC_REGTEMP_2,
JANETC_REGTEMP_3,
JANETC_REGTEMP_4,
JANETC_REGTEMP_5,
JANETC_REGTEMP_6,
JANETC_REGTEMP_7
} JanetcRegisterTemp;
typedef struct {
uint32_t *chunks;
@ -45,23 +45,23 @@ typedef struct {
int32_t capacity; /* amount allocated for chunks */
int32_t max; /* The maximum allocated register so far */
int32_t regtemps; /* Hold which tempregistered are alloced. */
} DstcRegisterAllocator;
} JanetcRegisterAllocator;
void dstc_regalloc_init(DstcRegisterAllocator *ra);
void dstc_regalloc_deinit(DstcRegisterAllocator *ra);
void janetc_regalloc_init(JanetcRegisterAllocator *ra);
void janetc_regalloc_deinit(JanetcRegisterAllocator *ra);
int32_t dstc_regalloc_1(DstcRegisterAllocator *ra);
void dstc_regalloc_free(DstcRegisterAllocator *ra, int32_t reg);
int32_t dstc_regalloc_temp(DstcRegisterAllocator *ra, DstcRegisterTemp nth);
void dstc_regalloc_freetemp(DstcRegisterAllocator *ra, int32_t reg, DstcRegisterTemp nth);
void dstc_regalloc_clone(DstcRegisterAllocator *dest, DstcRegisterAllocator *src);
void dstc_regalloc_touch(DstcRegisterAllocator *ra, int32_t reg);
int32_t janetc_regalloc_1(JanetcRegisterAllocator *ra);
void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg);
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth);
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
/* Mutli-slot allocation disabled */
/*
int32_t dstc_regalloc_n(DstcRegisterAllocator *ra, int32_t n);
int32_t dstc_regalloc_call(DstcRegisterAllocator *ra, int32_t callee, int32_t nargs);
void dstc_regalloc_freerange(DstcRegisterAllocator *ra, int32_t regstart, int32_t n);
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n);
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs);
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t regstart, int32_t n);
*/
#endif

76
src/core/run.c
View File

@ -20,18 +20,18 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "state.h"
/* Error reporting */
static void print_error_report(DstFiber *fiber, const char *errtype, Dst err) {
const char *errstr = (const char *)dst_to_string(err);
static void print_error_report(JanetFiber *fiber, const char *errtype, Janet err) {
const char *errstr = (const char *)janet_to_string(err);
printf("%s error: %s\n", errtype, errstr);
if (!fiber) return;
int32_t i = fiber->frame;
while (i > 0) {
DstStackFrame *frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE);
DstFuncDef *def = NULL;
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
JanetFuncDef *def = NULL;
i = frame->prevframe;
printf(" at");
@ -43,19 +43,19 @@ static void print_error_report(DstFiber *fiber, const char *errtype, Dst err) {
printf(" %s", (const char *)def->source);
}
} else {
DstCFunction cfun = (DstCFunction)(frame->pc);
JanetCFunction cfun = (JanetCFunction)(frame->pc);
if (cfun) {
Dst name = dst_table_get(dst_vm_registry, dst_wrap_cfunction(cfun));
if (!dst_checktype(name, DST_NIL))
printf(" [%s]", (const char *)dst_to_string(name));
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
if (!janet_checktype(name, JANET_NIL))
printf(" [%s]", (const char *)janet_to_string(name));
}
}
if (frame->flags & DST_STACKFRAME_TAILCALL)
if (frame->flags & JANET_STACKFRAME_TAILCALL)
printf(" (tailcall)");
if (frame->func && frame->pc) {
int32_t off = (int32_t) (frame->pc - def->bytecode);
if (def->sourcemap) {
DstSourceMapping mapping = def->sourcemap[off];
JanetSourceMapping mapping = def->sourcemap[off];
printf(" on line %d, column %d", mapping.line, mapping.column);
} else {
printf(" pc=%d", off);
@ -66,72 +66,72 @@ static void print_error_report(DstFiber *fiber, const char *errtype, Dst err) {
}
/* Run a string */
int dst_dobytes(DstTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath) {
DstParser parser;
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath) {
JanetParser parser;
int errflags = 0;
int32_t index = 0;
int dudeol = 0;
int done = 0;
const uint8_t *where = sourcePath ? dst_cstring(sourcePath) : NULL;
if (where) dst_gcroot(dst_wrap_string(where));
dst_parser_init(&parser);
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
if (where) janet_gcroot(janet_wrap_string(where));
janet_parser_init(&parser);
while (!errflags && !done) {
switch (dst_parser_status(&parser)) {
case DST_PARSE_FULL:
switch (janet_parser_status(&parser)) {
case JANET_PARSE_FULL:
{
Dst form = dst_parser_produce(&parser);
DstCompileResult cres = dst_compile(form, env, where);
if (cres.status == DST_COMPILE_OK) {
DstFunction *f = dst_thunk(cres.funcdef);
DstFiber *fiber = dst_fiber(f, 64);
Dst ret = dst_wrap_nil();
DstSignal status = dst_run(fiber, &ret);
if (status != DST_SIGNAL_OK) {
Janet form = janet_parser_produce(&parser);
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
JanetFiber *fiber = janet_fiber(f, 64);
Janet ret = janet_wrap_nil();
JanetSignal status = janet_run(fiber, &ret);
if (status != JANET_SIGNAL_OK) {
print_error_report(fiber, "runtime", ret);
errflags |= 0x01;
}
} else {
print_error_report(cres.macrofiber, "compile",
dst_wrap_string(cres.error));
janet_wrap_string(cres.error));
errflags |= 0x02;
}
}
break;
case DST_PARSE_ERROR:
case JANET_PARSE_ERROR:
errflags |= 0x04;
printf("parse error: %s\n", dst_parser_error(&parser));
printf("parse error: %s\n", janet_parser_error(&parser));
break;
case DST_PARSE_PENDING:
case JANET_PARSE_PENDING:
if (index >= len) {
if (dudeol) {
errflags |= 0x04;
printf("internal parse error: unexpected end of source\n");
} else {
dudeol = 1;
dst_parser_consume(&parser, '\n');
janet_parser_consume(&parser, '\n');
}
} else {
dst_parser_consume(&parser, bytes[index++]);
janet_parser_consume(&parser, bytes[index++]);
}
break;
case DST_PARSE_ROOT:
case JANET_PARSE_ROOT:
if (index >= len) {
done = 1;
} else {
dst_parser_consume(&parser, bytes[index++]);
janet_parser_consume(&parser, bytes[index++]);
}
break;
}
}
dst_parser_deinit(&parser);
if (where) dst_gcunroot(dst_wrap_string(where));
janet_parser_deinit(&parser);
if (where) janet_gcunroot(janet_wrap_string(where));
return errflags;
}
int dst_dostring(DstTable *env, const char *str, const char *sourcePath) {
int janet_dostring(JanetTable *env, const char *str, const char *sourcePath) {
int32_t len = 0;
while (str[len]) ++len;
return dst_dobytes(env, (const uint8_t *)str, len, sourcePath);
return janet_dobytes(env, (const uint8_t *)str, len, sourcePath);
}

524
src/core/specials.c
View File

@ -20,218 +20,218 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "compile.h"
#include "util.h"
#include "vector.h"
#include "emit.h"
static DstSlot dstc_quote(DstFopts opts, int32_t argn, const Dst *argv) {
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 1) {
dstc_cerror(opts.compiler, "expected 1 argument");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(opts.compiler, "expected 1 argument");
return janetc_cslot(janet_wrap_nil());
}
return dstc_cslot(argv[0]);
return janetc_cslot(argv[0]);
}
/* Preform destructuring. Be careful to
* keep the order registers are freed.
* Returns if the slot 'right' can be freed. */
static int destructure(DstCompiler *c,
Dst left,
DstSlot right,
int (*leaf)(DstCompiler *c,
static int destructure(JanetCompiler *c,
Janet left,
JanetSlot right,
int (*leaf)(JanetCompiler *c,
const uint8_t *sym,
DstSlot s,
DstTable *attr),
DstTable *attr) {
switch (dst_type(left)) {
JanetSlot s,
JanetTable *attr),
JanetTable *attr) {
switch (janet_type(left)) {
default:
dstc_cerror(c, "unexpected type in destructuring");
janetc_cerror(c, "unexpected type in destructuring");
return 1;
case DST_SYMBOL:
case JANET_SYMBOL:
/* Leaf, assign right to left */
return leaf(c, dst_unwrap_symbol(left), right, attr);
case DST_TUPLE:
case DST_ARRAY:
return leaf(c, janet_unwrap_symbol(left), right, attr);
case JANET_TUPLE:
case JANET_ARRAY:
{
int32_t i, len;
const Dst *values;
dst_indexed_view(left, &values, &len);
const Janet *values;
janet_indexed_view(left, &values, &len);
for (i = 0; i < len; i++) {
DstSlot nextright = dstc_farslot(c);
Dst subval = values[i];
JanetSlot nextright = janetc_farslot(c);
Janet subval = values[i];
if (i < 0x100) {
dstc_emit_ssu(c, DOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
} else {
DstSlot k = dstc_cslot(dst_wrap_integer(i));
dstc_emit_sss(c, DOP_GET, nextright, right, k, 1);
JanetSlot k = janetc_cslot(janet_wrap_integer(i));
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
}
if (destructure(c, subval, nextright, leaf, attr))
dstc_freeslot(c, nextright);
janetc_freeslot(c, nextright);
}
}
return 1;
case DST_TABLE:
case DST_STRUCT:
case JANET_TABLE:
case JANET_STRUCT:
{
const DstKV *kvs = NULL;
const JanetKV *kvs = NULL;
int32_t i, cap, len;
dst_dictionary_view(left, &kvs, &len, &cap);
janet_dictionary_view(left, &kvs, &len, &cap);
for (i = 0; i < cap; i++) {
if (dst_checktype(kvs[i].key, DST_NIL)) continue;
DstSlot nextright = dstc_farslot(c);
DstSlot k = dstc_value(dstc_fopts_default(c), kvs[i].key);
dstc_emit_sss(c, DOP_GET, nextright, right, k, 1);
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
JanetSlot nextright = janetc_farslot(c);
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
if (destructure(c, kvs[i].value, nextright, leaf, attr))
dstc_freeslot(c, nextright);
janetc_freeslot(c, nextright);
}
}
return 1;
}
}
static DstSlot dstc_varset(DstFopts opts, int32_t argn, const Dst *argv) {
DstFopts subopts = dstc_fopts_default(opts.compiler);
DstSlot ret, dest;
Dst head;
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetFopts subopts = janetc_fopts_default(opts.compiler);
JanetSlot ret, dest;
Janet head;
if (argn != 2) {
dstc_cerror(opts.compiler, "expected 2 arguments");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(opts.compiler, "expected 2 arguments");
return janetc_cslot(janet_wrap_nil());
}
head = argv[0];
if (!dst_checktype(head, DST_SYMBOL)) {
dstc_cerror(opts.compiler, "expected symbol");
return dstc_cslot(dst_wrap_nil());
if (!janet_checktype(head, JANET_SYMBOL)) {
janetc_cerror(opts.compiler, "expected symbol");
return janetc_cslot(janet_wrap_nil());
}
dest = dstc_resolve(opts.compiler, dst_unwrap_symbol(head));
if (!(dest.flags & DST_SLOT_MUTABLE)) {
dstc_cerror(opts.compiler, "cannot set constant");
return dstc_cslot(dst_wrap_nil());
dest = janetc_resolve(opts.compiler, janet_unwrap_symbol(head));
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
janetc_cerror(opts.compiler, "cannot set constant");
return janetc_cslot(janet_wrap_nil());
}
subopts.flags = DST_FOPTS_HINT;
subopts.flags = JANET_FOPTS_HINT;
subopts.hint = dest;
ret = dstc_value(subopts, argv[1]);
dstc_copy(opts.compiler, dest, ret);
ret = janetc_value(subopts, argv[1]);
janetc_copy(opts.compiler, dest, ret);
return ret;
}
/* Add attributes to a global def or var table */
static DstTable *handleattr(DstCompiler *c, int32_t argn, const Dst *argv) {
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
int32_t i;
DstTable *tab = dst_table(2);
JanetTable *tab = janet_table(2);
for (i = 1; i < argn - 1; i++) {
Dst attr = argv[i];
switch (dst_type(attr)) {
Janet attr = argv[i];
switch (janet_type(attr)) {
default:
dstc_cerror(c, "could not add metadata to binding");
janetc_cerror(c, "could not add metadata to binding");
break;
case DST_SYMBOL:
dst_table_put(tab, attr, dst_wrap_true());
case JANET_SYMBOL:
janet_table_put(tab, attr, janet_wrap_true());
break;
case DST_STRING:
dst_table_put(tab, dst_csymbolv("doc"), attr);
case JANET_STRING:
janet_table_put(tab, janet_csymbolv("doc"), attr);
break;
}
}
return tab;
}
static DstSlot dohead(DstCompiler *c, DstFopts opts, Dst *head, int32_t argn, const Dst *argv) {
DstFopts subopts = dstc_fopts_default(c);
DstSlot ret;
static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
JanetFopts subopts = janetc_fopts_default(c);
JanetSlot ret;
if (argn < 2) {
dstc_cerror(c, "expected at least 2 arguments");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(c, "expected at least 2 arguments");
return janetc_cslot(janet_wrap_nil());
}
*head = argv[0];
subopts.flags = opts.flags & ~(DST_FOPTS_TAIL | DST_FOPTS_DROP);
subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
subopts.hint = opts.hint;
ret = dstc_value(subopts, argv[argn - 1]);
ret = janetc_value(subopts, argv[argn - 1]);
return ret;
}
/* Def or var a symbol in a local scope */
static int namelocal(DstCompiler *c, const uint8_t *head, int32_t flags, DstSlot ret) {
int isUnnamedRegister = !(ret.flags & DST_SLOT_NAMED) &&
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
if (!isUnnamedRegister) {
/* Slot is not able to be named */
DstSlot localslot = dstc_farslot(c);
dstc_copy(c, localslot, ret);
JanetSlot localslot = janetc_farslot(c);
janetc_copy(c, localslot, ret);
ret = localslot;
}
ret.flags |= flags;
dstc_nameslot(c, head, ret);
janetc_nameslot(c, head, ret);
return !isUnnamedRegister;
}
static int varleaf(
DstCompiler *c,
JanetCompiler *c,
const uint8_t *sym,
DstSlot s,
DstTable *attr) {
if (c->scope->flags & DST_SCOPE_TOP) {
JanetSlot s,
JanetTable *attr) {
if (c->scope->flags & JANET_SCOPE_TOP) {
/* Global var, generate var */
DstSlot refslot;
DstTable *reftab = dst_table(1);
JanetSlot refslot;
JanetTable *reftab = janet_table(1);
reftab->proto = attr;
DstArray *ref = dst_array(1);
dst_array_push(ref, dst_wrap_nil());
dst_table_put(reftab, dst_csymbolv(":ref"), dst_wrap_array(ref));
dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(reftab));
refslot = dstc_cslot(dst_wrap_array(ref));
dstc_emit_ssu(c, DOP_PUT_INDEX, refslot, s, 0, 0);
JanetArray *ref = janet_array(1);
janet_array_push(ref, janet_wrap_nil());
janet_table_put(reftab, janet_csymbolv(":ref"), janet_wrap_array(ref));
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
refslot = janetc_cslot(janet_wrap_array(ref));
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
return 1;
} else {
return namelocal(c, sym, DST_SLOT_MUTABLE, s);
return namelocal(c, sym, JANET_SLOT_MUTABLE, s);
}
}
static DstSlot dstc_var(DstFopts opts, int32_t argn, const Dst *argv) {
DstCompiler *c = opts.compiler;
Dst head;
DstSlot ret = dohead(c, opts, &head, argn, argv);
if (c->result.status == DST_COMPILE_ERROR)
return dstc_cslot(dst_wrap_nil());
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
Janet head;
JanetSlot ret = dohead(c, opts, &head, argn, argv);
if (c->result.status == JANET_COMPILE_ERROR)
return janetc_cslot(janet_wrap_nil());
if (destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv)))
dstc_freeslot(c, ret);
return dstc_cslot(dst_wrap_nil());
janetc_freeslot(c, ret);
return janetc_cslot(janet_wrap_nil());
}
static int defleaf(
DstCompiler *c,
JanetCompiler *c,
const uint8_t *sym,
DstSlot s,
DstTable *attr) {
if (c->scope->flags & DST_SCOPE_TOP) {
DstTable *tab = dst_table(2);
JanetSlot s,
JanetTable *attr) {
if (c->scope->flags & JANET_SCOPE_TOP) {
JanetTable *tab = janet_table(2);
tab->proto = attr;
DstSlot valsym = dstc_cslot(dst_csymbolv(":value"));
DstSlot tabslot = dstc_cslot(dst_wrap_table(tab));
JanetSlot valsym = janetc_cslot(janet_csymbolv(":value"));
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
/* Add env entry to env */
dst_table_put(c->env, dst_wrap_symbol(sym), dst_wrap_table(tab));
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(tab));
/* Put value in table when evaulated */
dstc_emit_sss(c, DOP_PUT, tabslot, valsym, s, 0);
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
return 1;
} else {
return namelocal(c, sym, 0, s);
}
}
static DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
DstCompiler *c = opts.compiler;
Dst head;
opts.flags &= ~DST_FOPTS_HINT;
DstSlot ret = dohead(c, opts, &head, argn, argv);
if (c->result.status == DST_COMPILE_ERROR)
return dstc_cslot(dst_wrap_nil());
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
Janet head;
opts.flags &= ~JANET_FOPTS_HINT;
JanetSlot ret = dohead(c, opts, &head, argn, argv);
if (c->result.status == JANET_COMPILE_ERROR)
return janetc_cslot(janet_wrap_nil());
if (destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv)))
dstc_freeslot(c, ret);
return dstc_cslot(dst_wrap_nil());
janetc_freeslot(c, ret);
return janetc_cslot(janet_wrap_nil());
}
/*
@ -245,122 +245,122 @@ static DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
* ...
* :done
*/
static DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
DstCompiler *c = opts.compiler;
static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
int32_t labelr, labeljr, labeld, labeljd;
DstFopts condopts, bodyopts;
DstSlot cond, left, right, target;
Dst truebody, falsebody;
DstScope condscope, tempscope;
const int tail = opts.flags & DST_FOPTS_TAIL;
const int drop = opts.flags & DST_FOPTS_DROP;
JanetFopts condopts, bodyopts;
JanetSlot cond, left, right, target;
Janet truebody, falsebody;
JanetScope condscope, tempscope;
const int tail = opts.flags & JANET_FOPTS_TAIL;
const int drop = opts.flags & JANET_FOPTS_DROP;
if (argn < 2 || argn > 3) {
dstc_cerror(c, "expected 2 or 3 arguments to if");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(c, "expected 2 or 3 arguments to if");
return janetc_cslot(janet_wrap_nil());
}
/* Get the bodies of the if expression */
truebody = argv[1];
falsebody = argn > 2 ? argv[2] : dst_wrap_nil();
falsebody = argn > 2 ? argv[2] : janet_wrap_nil();
/* Get options */
condopts = dstc_fopts_default(c);
condopts = janetc_fopts_default(c);
bodyopts = opts;
/* Set target for compilation */
target = (drop || tail)
? dstc_cslot(dst_wrap_nil())
: dstc_gettarget(opts);
? janetc_cslot(janet_wrap_nil())
: janetc_gettarget(opts);
/* Compile condition */
dstc_scope(&condscope, c, 0, "if");
cond = dstc_value(condopts, argv[0]);
janetc_scope(&condscope, c, 0, "if");
cond = janetc_value(condopts, argv[0]);
/* Check constant condition. */
/* TODO: Use type info for more short circuits */
if (cond.flags & DST_SLOT_CONSTANT) {
if (!dst_truthy(cond.constant)) {
if (cond.flags & JANET_SLOT_CONSTANT) {
if (!janet_truthy(cond.constant)) {
/* Swap the true and false bodies */
Dst temp = falsebody;
Janet temp = falsebody;
falsebody = truebody;
truebody = temp;
}
dstc_scope(&tempscope, c, 0, "if-body");
target = dstc_value(bodyopts, truebody);
dstc_popscope(c);
dstc_popscope(c);
dstc_throwaway(bodyopts, falsebody);
janetc_scope(&tempscope, c, 0, "if-body");
target = janetc_value(bodyopts, truebody);
janetc_popscope(c);
janetc_popscope(c);
janetc_throwaway(bodyopts, falsebody);
return target;
}
/* Compile jump to right */
labeljr = dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
/* Condition left body */
dstc_scope(&tempscope, c, 0, "if-true");
left = dstc_value(bodyopts, truebody);
if (!drop && !tail) dstc_copy(c, target, left);
dstc_popscope(c);
janetc_scope(&tempscope, c, 0, "if-true");
left = janetc_value(bodyopts, truebody);
if (!drop && !tail) janetc_copy(c, target, left);
janetc_popscope(c);
/* Compile jump to done */
labeljd = dst_v_count(c->buffer);
if (!tail) dstc_emit(c, DOP_JUMP);
labeljd = janet_v_count(c->buffer);
if (!tail) janetc_emit(c, JOP_JUMP);
/* Compile right body */
labelr = dst_v_count(c->buffer);
dstc_scope(&tempscope, c, 0, "if-false");
right = dstc_value(bodyopts, falsebody);
if (!drop && !tail) dstc_copy(c, target, right);
dstc_popscope(c);
labelr = janet_v_count(c->buffer);
janetc_scope(&tempscope, c, 0, "if-false");
right = janetc_value(bodyopts, falsebody);
if (!drop && !tail) janetc_copy(c, target, right);
janetc_popscope(c);
/* Pop main scope */
dstc_popscope(c);
janetc_popscope(c);
/* Write jumps - only add jump lengths if jump actually emitted */
labeld = dst_v_count(c->buffer);
labeld = janet_v_count(c->buffer);
c->buffer[labeljr] |= (labelr - labeljr) << 16;
if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8;
if (tail) target.flags |= DST_SLOT_RETURNED;
if (tail) target.flags |= JANET_SLOT_RETURNED;
return target;
}
/* Compile a do form. Do forms execute their body sequentially and
* evaluate to the last expression in the body. */
static DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
int32_t i;
DstSlot ret = dstc_cslot(dst_wrap_nil());
DstCompiler *c = opts.compiler;
DstFopts subopts = dstc_fopts_default(c);
DstScope tempscope;
dstc_scope(&tempscope, c, 0, "do");
JanetSlot ret = janetc_cslot(janet_wrap_nil());
JanetCompiler *c = opts.compiler;
JanetFopts subopts = janetc_fopts_default(c);
JanetScope tempscope;
janetc_scope(&tempscope, c, 0, "do");
for (i = 0; i < argn; i++) {
if (i != argn - 1) {
subopts.flags = DST_FOPTS_DROP;
subopts.flags = JANET_FOPTS_DROP;
} else {
subopts = opts;
}
ret = dstc_value(subopts, argv[i]);
ret = janetc_value(subopts, argv[i]);
if (i != argn - 1) {
dstc_freeslot(c, ret);
janetc_freeslot(c, ret);
}
}
dstc_popscope_keepslot(c, ret);
janetc_popscope_keepslot(c, ret);
return ret;
}
/* Add a funcdef to the top most function scope */
static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) {
DstScope *scope = c->scope;
static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
JanetScope *scope = c->scope;
while (scope) {
if (scope->flags & DST_SCOPE_FUNCTION)
if (scope->flags & JANET_SCOPE_FUNCTION)
break;
scope = scope->parent;
}
dst_assert(scope, "could not add funcdef");
dst_v_push(scope->defs, def);
return dst_v_count(scope->defs) - 1;
janet_assert(scope, "could not add funcdef");
janet_v_push(scope->defs, def);
return janet_v_count(scope->defs) - 1;
}
/*
@ -372,32 +372,32 @@ static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) {
* jump :whiletop
* :done
*/
static DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
DstCompiler *c = opts.compiler;
DstSlot cond;
DstFopts subopts = dstc_fopts_default(c);
DstScope tempscope;
static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
JanetSlot cond;
JanetFopts subopts = janetc_fopts_default(c);
JanetScope tempscope;
int32_t labelwt, labeld, labeljt, labelc, i;
int infinite = 0;
if (argn < 2) {
dstc_cerror(c, "expected at least 2 arguments");
return dstc_cslot(dst_wrap_nil());
janetc_cerror(c, "expected at least 2 arguments");
return janetc_cslot(janet_wrap_nil());
}
labelwt = dst_v_count(c->buffer);
labelwt = janet_v_count(c->buffer);
dstc_scope(&tempscope, c, 0, "while");
janetc_scope(&tempscope, c, 0, "while");
/* Compile condition */
cond = dstc_value(subopts, argv[0]);
cond = janetc_value(subopts, argv[0]);
/* Check for constant condition */
if (cond.flags & DST_SLOT_CONSTANT) {
if (cond.flags & JANET_SLOT_CONSTANT) {
/* Loop never executes */
if (!dst_truthy(cond.constant)) {
dstc_popscope(c);
return dstc_cslot(dst_wrap_nil());
if (!janet_truthy(cond.constant)) {
janetc_popscope(c);
return janetc_cslot(janet_wrap_nil());
}
/* Infinite loop */
infinite = 1;
@ -406,83 +406,83 @@ static DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
/* Infinite loop does not need to check condition */
labelc = infinite
? 0
: dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
/* Compile body */
for (i = 1; i < argn; i++) {
subopts.flags = DST_FOPTS_DROP;
dstc_freeslot(c, dstc_value(subopts, argv[i]));
subopts.flags = JANET_FOPTS_DROP;
janetc_freeslot(c, janetc_value(subopts, argv[i]));
}
/* Check if closure created in while scope. If so,
* recompile in a function scope. */
if (tempscope.flags & DST_SCOPE_CLOSURE) {
tempscope.flags |= DST_SCOPE_UNUSED;
dstc_popscope(c);
dst_v__cnt(c->buffer) = labelwt;
dst_v__cnt(c->mapbuffer) = labelwt;
if (tempscope.flags & JANET_SCOPE_CLOSURE) {
tempscope.flags |= JANET_SCOPE_UNUSED;
janetc_popscope(c);
janet_v__cnt(c->buffer) = labelwt;
janet_v__cnt(c->mapbuffer) = labelwt;
dstc_scope(&tempscope, c, DST_SCOPE_FUNCTION, "while-iife");
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
/* Recompile in the function scope */
cond = dstc_value(subopts, argv[0]);
if (!(cond.flags & DST_SLOT_CONSTANT)) {
cond = janetc_value(subopts, argv[0]);
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
/* If not an infinte loop, return nil when condition false */
dstc_emit_si(c, DOP_JUMP_IF, cond, 2, 0);
dstc_emit(c, DOP_RETURN_NIL);
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
janetc_emit(c, JOP_RETURN_NIL);
}
for (i = 1; i < argn; i++) {
subopts.flags = DST_FOPTS_DROP;
dstc_freeslot(c, dstc_value(subopts, argv[i]));
subopts.flags = JANET_FOPTS_DROP;
janetc_freeslot(c, janetc_value(subopts, argv[i]));
}
/* But now add tail recursion */
int32_t tempself = dstc_regalloc_temp(&tempscope.ra, DSTC_REGTEMP_0);
dstc_emit(c, DOP_LOAD_SELF | (tempself << 8));
dstc_emit(c, DOP_TAILCALL | (tempself << 8));
int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0);
janetc_emit(c, JOP_LOAD_SELF | (tempself << 8));
janetc_emit(c, JOP_TAILCALL | (tempself << 8));
/* Compile function */
DstFuncDef *def = dstc_pop_funcdef(c);
def->name = dst_cstring("_while");
int32_t defindex = dstc_addfuncdef(c, def);
JanetFuncDef *def = janetc_pop_funcdef(c);
def->name = janet_cstring("_while");
int32_t defindex = janetc_addfuncdef(c, def);
/* And then load the closure and call it. */
int32_t cloreg = dstc_regalloc_temp(&c->scope->ra, DSTC_REGTEMP_0);
dstc_emit(c, DOP_CLOSURE | (cloreg << 8) | (defindex << 16));
dstc_emit(c, DOP_CALL | (cloreg << 8) | (cloreg << 16));
dstc_regalloc_free(&c->scope->ra, cloreg);
c->scope->flags |= DST_SCOPE_CLOSURE;
return dstc_cslot(dst_wrap_nil());
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16));
janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16));
janetc_regalloc_free(&c->scope->ra, cloreg);
c->scope->flags |= JANET_SCOPE_CLOSURE;
return janetc_cslot(janet_wrap_nil());
}
/* Compile jump to whiletop */
labeljt = dst_v_count(c->buffer);
dstc_emit(c, DOP_JUMP);
labeljt = janet_v_count(c->buffer);
janetc_emit(c, JOP_JUMP);
/* Calculate jumps */
labeld = dst_v_count(c->buffer);
labeld = janet_v_count(c->buffer);
if (!infinite) c->buffer[labelc] |= (labeld - labelc) << 16;
c->buffer[labeljt] |= (labelwt - labeljt) << 8;
/* Pop scope and return nil slot */
dstc_popscope(c);
janetc_popscope(c);
return dstc_cslot(dst_wrap_nil());
return janetc_cslot(janet_wrap_nil());
}
static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
DstCompiler *c = opts.compiler;
DstFuncDef *def;
DstSlot ret;
Dst head, paramv;
DstScope fnscope;
static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
JanetFuncDef *def;
JanetSlot ret;
Janet head, paramv;
JanetScope fnscope;
int32_t paramcount, argi, parami, arity, defindex;
DstFopts subopts = dstc_fopts_default(c);
const Dst *params;
JanetFopts subopts = janetc_fopts_default(c);
const Janet *params;
const char *errmsg = NULL;
int varargs = 0;
int selfref = 0;
/* Begin function */
c->scope->flags |= DST_SCOPE_CLOSURE;
dstc_scope(&fnscope, c, DST_SCOPE_FUNCTION, "function");
c->scope->flags |= JANET_SCOPE_CLOSURE;
janetc_scope(&fnscope, c, JANET_SCOPE_FUNCTION, "function");
if (argn < 2) {
errmsg = "expected at least 2 arguments to function literal";
@ -493,7 +493,7 @@ static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
parami = 0;
arity = 0;
head = argv[0];
if (dst_checktype(head, DST_SYMBOL)) {
if (janet_checktype(head, JANET_SYMBOL)) {
selfref = 1;
parami = 1;
}
@ -502,13 +502,13 @@ static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
goto error;
}
paramv = argv[parami];
if (dst_indexed_view(paramv, &params, &paramcount)) {
if (janet_indexed_view(paramv, &params, &paramcount)) {
int32_t i;
for (i = 0; i < paramcount; i++) {
Dst param = params[i];
if (dst_checktype(param, DST_SYMBOL)) {
Janet param = params[i];
if (janet_checktype(param, JANET_SYMBOL)) {
/* Check for varargs */
if (0 == dst_cstrcmp(dst_unwrap_symbol(param), "&")) {
if (0 == janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
if (i != paramcount - 2) {
errmsg = "variable argument symbol in unexpected location";
goto error;
@ -517,9 +517,9 @@ static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
arity--;
continue;
}
dstc_nameslot(c, dst_unwrap_symbol(param), dstc_farslot(c));
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
} else {
destructure(c, param, dstc_farslot(c), defleaf, NULL);
destructure(c, param, janetc_farslot(c), defleaf, NULL);
}
arity++;
}
@ -530,69 +530,69 @@ static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
/* Check for self ref */
if (selfref) {
DstSlot slot = dstc_farslot(c);
slot.flags = DST_SLOT_NAMED | DST_FUNCTION;
dstc_emit_s(c, DOP_LOAD_SELF, slot, 1);
dstc_nameslot(c, dst_unwrap_symbol(head), slot);
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot(c, janet_unwrap_symbol(head), slot);
}
/* Compile function body */
if (parami + 1 == argn) {
dstc_emit(c, DOP_RETURN_NIL);
janetc_emit(c, JOP_RETURN_NIL);
} else for (argi = parami + 1; argi < argn; argi++) {
subopts.flags = (argi == (argn - 1)) ? DST_FOPTS_TAIL : DST_FOPTS_DROP;
dstc_value(subopts, argv[argi]);
if (c->result.status == DST_COMPILE_ERROR)
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
janetc_value(subopts, argv[argi]);
if (c->result.status == JANET_COMPILE_ERROR)
goto error2;
}
/* Build function */
def = dstc_pop_funcdef(c);
def = janetc_pop_funcdef(c);
def->arity = arity;
/* Tuples indicated fixed arity, arrays indicate flexible arity */
/* TODO - revisit this */
if (varargs)
def->flags |= DST_FUNCDEF_FLAG_VARARG;
else if (dst_checktype(paramv, DST_TUPLE))
def->flags |= DST_FUNCDEF_FLAG_FIXARITY;
def->flags |= JANET_FUNCDEF_FLAG_VARARG;
else if (janet_checktype(paramv, JANET_TUPLE))
def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
if (selfref) def->name = dst_unwrap_symbol(head);
defindex = dstc_addfuncdef(c, def);
if (selfref) def->name = janet_unwrap_symbol(head);
defindex = janetc_addfuncdef(c, def);
/* Ensure enough slots for vararg function. */
if (arity + varargs > def->slotcount) def->slotcount = arity + varargs;
/* Instantiate closure */
ret = dstc_gettarget(opts);
dstc_emit_su(c, DOP_CLOSURE, ret, defindex, 1);
ret = janetc_gettarget(opts);
janetc_emit_su(c, JOP_CLOSURE, ret, defindex, 1);
return ret;
error:
dstc_cerror(c, errmsg);
janetc_cerror(c, errmsg);
error2:
dstc_popscope(c);
return dstc_cslot(dst_wrap_nil());
janetc_popscope(c);
return janetc_cslot(janet_wrap_nil());
}
/* Keep in lexicographic order */
static const DstSpecial dstc_specials[] = {
{":=", dstc_varset},
{"def", dstc_def},
{"do", dstc_do},
{"fn", dstc_fn},
{"if", dstc_if},
{"quote", dstc_quote},
{"var", dstc_var},
{"while", dstc_while}
static const JanetSpecial janetc_specials[] = {
{":=", janetc_varset},
{"def", janetc_def},
{"do", janetc_do},
{"fn", janetc_fn},
{"if", janetc_if},
{"quote", janetc_quote},
{"var", janetc_var},
{"while", janetc_while}
};
/* Find a special */
const DstSpecial *dstc_special(const uint8_t *name) {
return dst_strbinsearch(
&dstc_specials,
sizeof(dstc_specials)/sizeof(DstSpecial),
sizeof(DstSpecial),
const JanetSpecial *janetc_special(const uint8_t *name) {
return janet_strbinsearch(
&janetc_specials,
sizeof(janetc_specials)/sizeof(JanetSpecial),
sizeof(JanetSpecial),
name);
}

36
src/core/state.h
View File

@ -20,8 +20,8 @@
* IN THE SOFTWARE.
*/
#ifndef DST_STATE_H_defined
#define DST_STATE_H_defined
#ifndef JANET_STATE_H_defined
#define JANET_STATE_H_defined
#include <stdint.h>
@ -33,31 +33,31 @@
* state should allow easy multithreading. */
/* How many VM stacks have been entered */
extern DST_THREAD_LOCAL int dst_vm_stackn;
extern JANET_THREAD_LOCAL int janet_vm_stackn;
/* The current running fiber on the current thread.
* Set and unset by dst_run. */
extern DST_THREAD_LOCAL DstFiber *dst_vm_fiber;
* Set and unset by janet_run. */
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
/* The global registry for c functions. Used to store metadata
* along with otherwise bare c function pointers. */
extern DST_THREAD_LOCAL DstTable *dst_vm_registry;
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
/* Immutable value cache */
extern DST_THREAD_LOCAL const uint8_t **dst_vm_cache;
extern DST_THREAD_LOCAL uint32_t dst_vm_cache_capacity;
extern DST_THREAD_LOCAL uint32_t dst_vm_cache_count;
extern DST_THREAD_LOCAL uint32_t dst_vm_cache_deleted;
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_count;
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
/* Garbage collection */
extern DST_THREAD_LOCAL void *dst_vm_blocks;
extern DST_THREAD_LOCAL uint32_t dst_vm_gc_interval;
extern DST_THREAD_LOCAL uint32_t dst_vm_next_collection;
extern DST_THREAD_LOCAL int dst_vm_gc_suspend;
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
extern JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
extern JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
/* GC roots */
extern DST_THREAD_LOCAL Dst *dst_vm_roots;
extern DST_THREAD_LOCAL uint32_t dst_vm_root_count;
extern DST_THREAD_LOCAL uint32_t dst_vm_root_capacity;
extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
#endif /* DST_STATE_H_defined */
#endif /* JANET_STATE_H_defined */

574
src/core/string.c
View File

File diff suppressed because it is too large Load Diff

34
src/core/strtod.c
View File

@ -28,7 +28,7 @@
* reasonable).
*
* This version has been modified for much greater flexibility in parsing, such
* as choosing the radix, supporting integer output, and returning Dsts
* as choosing the radix, supporting integer output, and returning Janets
* directly.
*
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X where R is the radix, I is
@ -36,14 +36,14 @@
* signs, radix, decimal point, fractional part, and exponent can be ommited.
* The number will be considered and integer if the there is no decimal point
* and no exponent. Any number greater the 2^32-1 or less than -(2^32) will be
* coerced to a double. If there is an error, the function dst_scan_number will
* return a dst nil. The radix is assumed to be 10 if omitted, and the E
* coerced to a double. If there is an error, the function janet_scan_number will
* return a janet nil. The radix is assumed to be 10 if omitted, and the E
* separator for the exponent can only be used when the radix is 10. This is
* because E is a vaid digit in bases 15 or greater. For bases greater than 10,
* the letters are used as digitis. A through Z correspond to the digits 10
* through 35, and the lowercase letters have the same values. The radix number
* is always in base 10. For example, a hexidecimal number could be written
* '16rdeadbeef'. dst_scan_number also supports some c style syntax for
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
* hexidecimal literals. The previous number could also be written
* '0xdeadbeef'. Note that in this case, the number will actually be a double
* as it will not fit in the range for a signed 32 bit integer. The string
@ -51,7 +51,7 @@
/* TODO take down missle defence */
#include <dst/dst.h>
#include <janet/janet.h>
#include <math.h>
/* Lookup table for getting values of characters when parsing numbers. Handles
@ -125,7 +125,7 @@ static double convert(
/* Result of scanning a number source string. Will be further processed
* depending on the desired resultant type. */
struct DstScanRes {
struct JanetScanRes {
uint64_t mant;
int32_t ex;
int error;
@ -140,11 +140,11 @@ struct DstScanRes {
* The exponent will be in a signed 32 bit integer. Will also check if
* the decimal point has been seen. Returns -1 if there is an invalid
* number. */
static struct DstScanRes dst_scan_impl(
static struct JanetScanRes janet_scan_impl(
const uint8_t *str,
int32_t len) {
struct DstScanRes res;
struct JanetScanRes res;
const uint8_t *end = str + len;
/* Initialize flags */
@ -269,11 +269,11 @@ static struct DstScanRes dst_scan_impl(
/* Scan an integer from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
int32_t dst_scan_integer(
int32_t janet_scan_integer(
const uint8_t *str,
int32_t len,
int *err) {
struct DstScanRes res = dst_scan_impl(str, len);
struct JanetScanRes res = janet_scan_impl(str, len);
int64_t i64;
if (res.error) goto error;
if (res.seenpoint) goto error;
@ -296,11 +296,11 @@ int32_t dst_scan_integer(
/* Scan a real (double) from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
double dst_scan_real(
double janet_scan_real(
const uint8_t *str,
int32_t len,
int *err) {
struct DstScanRes res = dst_scan_impl(str, len);
struct JanetScanRes res = janet_scan_impl(str, len);
if (res.error) {
if (NULL != err)
*err = 1;
@ -315,17 +315,17 @@ double dst_scan_real(
/* Scans a number from a string. Can return either an integer or a real if
* the number cannot be represented as an integer. Will return nil in case of
* an error. */
Dst dst_scan_number(
Janet janet_scan_number(
const uint8_t *str,
int32_t len) {
struct DstScanRes res = dst_scan_impl(str, len);
struct JanetScanRes res = janet_scan_impl(str, len);
if (res.error)
return dst_wrap_nil();
return janet_wrap_nil();
if (!res.foundexp && !res.seenpoint) {
int64_t i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
if (i64 <= INT32_MAX && i64 >= INT32_MIN) {
return dst_wrap_integer((int32_t) i64);
return janet_wrap_integer((int32_t) i64);
}
}
return dst_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
return janet_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
}

150
src/core/struct.c
View File

@ -20,39 +20,39 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "gc.h"
#include "util.h"
#define dst_struct_maphash(cap, hash) ((uint32_t)(hash & (cap - 1)));
#define janet_struct_maphash(cap, hash) ((uint32_t)(hash & (cap - 1)));
/* Begin creation of a struct */
DstKV *dst_struct_begin(int32_t count) {
JanetKV *janet_struct_begin(int32_t count) {
/* Calculate capacity as power of 2 after 2 * count. */
int32_t capacity = dst_tablen(2 * count);
if (capacity < 0) capacity = dst_tablen(count + 1);
int32_t capacity = janet_tablen(2 * count);
if (capacity < 0) capacity = janet_tablen(count + 1);
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(DstKV));
char *data = dst_gcalloc(DST_MEMORY_STRUCT, s);
DstKV *st = (DstKV *) (data + 4 * sizeof(int32_t));
dst_memempty(st, capacity);
dst_struct_length(st) = count;
dst_struct_capacity(st) = capacity;
dst_struct_hash(st) = 0;
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
JanetKV *st = (JanetKV *) (data + 4 * sizeof(int32_t));
janet_memempty(st, capacity);
janet_struct_length(st) = count;
janet_struct_capacity(st) = capacity;
janet_struct_hash(st) = 0;
return st;
}
/* Find an item in a struct */
const DstKV *dst_struct_find(const DstKV *st, Dst key) {
int32_t cap = dst_struct_capacity(st);
int32_t index = dst_struct_maphash(cap, dst_hash(key));
const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
int32_t cap = janet_struct_capacity(st);
int32_t index = janet_struct_maphash(cap, janet_hash(key));
int32_t i;
for (i = index; i < cap; i++)
if (dst_checktype(st[i].key, DST_NIL) || dst_equals(st[i].key, key))
if (janet_checktype(st[i].key, JANET_NIL) || janet_equals(st[i].key, key))
return st + i;
for (i = 0; i < index; i++)
if (dst_checktype(st[i].key, DST_NIL) || dst_equals(st[i].key, key))
if (janet_checktype(st[i].key, JANET_NIL) || janet_equals(st[i].key, key))
return st + i;
return NULL;
}
@ -65,27 +65,27 @@ const DstKV *dst_struct_find(const DstKV *st, Dst key) {
* preforms an in-place insertion sort. This ensures the internal structure of the
* hash map is independant of insertion order.
*/
void dst_struct_put(DstKV *st, Dst key, Dst value) {
int32_t cap = dst_struct_capacity(st);
int32_t hash = dst_hash(key);
int32_t index = dst_struct_maphash(cap, hash);
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
int32_t cap = janet_struct_capacity(st);
int32_t hash = janet_hash(key);
int32_t index = janet_struct_maphash(cap, hash);
int32_t i, j, dist;
int32_t bounds[4] = {index, cap, 0, index};
if (dst_checktype(key, DST_NIL) || dst_checktype(value, DST_NIL)) return;
if (janet_checktype(key, JANET_NIL) || janet_checktype(value, JANET_NIL)) return;
/* Avoid extra items */
if (dst_struct_hash(st) == dst_struct_length(st)) return;
if (janet_struct_hash(st) == janet_struct_length(st)) return;
for (dist = 0, j = 0; j < 4; j += 2)
for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) {
int status;
int32_t otherhash;
int32_t otherindex, otherdist;
DstKV *kv = st + i;
JanetKV *kv = st + i;
/* We found an empty slot, so just add key and value */
if (dst_checktype(kv->key, DST_NIL)) {
if (janet_checktype(kv->key, JANET_NIL)) {
kv->key = key;
kv->value = value;
/* Update the temporary count */
dst_struct_hash(st)++;
janet_struct_hash(st)++;
return;
}
/* Robinhood hashing - check if colliding kv pair
@ -94,8 +94,8 @@ void dst_struct_put(DstKV *st, Dst key, Dst value) {
* with different order have the same internal layout, and therefor
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
* Collisions are resolved via an insertion sort insertion. */
otherhash = dst_hash(kv->key);
otherindex = dst_struct_maphash(cap, otherhash);
otherhash = janet_hash(kv->key);
otherindex = janet_struct_maphash(cap, otherhash);
otherdist = (i + cap - otherindex) & (cap - 1);
if (dist < otherdist)
status = -1;
@ -106,11 +106,11 @@ void dst_struct_put(DstKV *st, Dst key, Dst value) {
else if (otherhash < hash)
status = 1;
else
status = dst_compare(key, kv->key);
status = janet_compare(key, kv->key);
/* If other is closer to their ideal slot */
if (status == 1) {
/* Swap current kv pair with pair in slot */
DstKV temp = *kv;
JanetKV temp = *kv;
kv->key = key;
kv->value = value;
key = temp.key;
@ -121,97 +121,97 @@ void dst_struct_put(DstKV *st, Dst key, Dst value) {
} else if (status == 0) {
/* This should not happen - it means
* than a key was added to the struct more than once */
dst_exit("struct double put fail");
janet_exit("struct double put fail");
return;
}
}
}
/* Finish building a struct */
const DstKV *dst_struct_end(DstKV *st) {
if (dst_struct_hash(st) != dst_struct_length(st)) {
const JanetKV *janet_struct_end(JanetKV *st) {
if (janet_struct_hash(st) != janet_struct_length(st)) {
/* Error building struct, probably duplicate values. We need to rebuild
* the struct using only the values that went in. The second creation should always
* succeed. */
int32_t i, realCount;
DstKV *newst;
JanetKV *newst;
realCount = 0;
for (i = 0; i < dst_struct_capacity(st); i++) {
DstKV *kv = st + i;
realCount += dst_checktype(kv->key, DST_NIL) ? 1 : 0;
for (i = 0; i < janet_struct_capacity(st); i++) {
JanetKV *kv = st + i;
realCount += janet_checktype(kv->key, JANET_NIL) ? 1 : 0;
}
newst = dst_struct_begin(realCount);
for (i = 0; i < dst_struct_capacity(st); i++) {
DstKV *kv = st + i;
if (!dst_checktype(kv->key, DST_NIL)) {
dst_struct_put(newst, kv->key, kv->value);
newst = janet_struct_begin(realCount);
for (i = 0; i < janet_struct_capacity(st); i++) {
JanetKV *kv = st + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_struct_put(newst, kv->key, kv->value);
}
}
st = newst;
}
dst_struct_hash(st) = dst_kv_calchash(st, dst_struct_capacity(st));
return (const DstKV *)st;
janet_struct_hash(st) = janet_kv_calchash(st, janet_struct_capacity(st));
return (const JanetKV *)st;
}
/* Get an item from a struct */
Dst dst_struct_get(const DstKV *st, Dst key) {
const DstKV *kv = dst_struct_find(st, key);
return kv ? kv->value : dst_wrap_nil();
Janet janet_struct_get(const JanetKV *st, Janet key) {
const JanetKV *kv = janet_struct_find(st, key);
return kv ? kv->value : janet_wrap_nil();
}
/* Get the next key in a struct */
const DstKV *dst_struct_next(const DstKV *st, const DstKV *kv) {
const DstKV *end = st + dst_struct_capacity(st);
const JanetKV *janet_struct_next(const JanetKV *st, const JanetKV *kv) {
const JanetKV *end = st + janet_struct_capacity(st);
kv = (kv == NULL) ? st : kv + 1;
while (kv < end) {
if (!dst_checktype(kv->key, DST_NIL)) return kv;
if (!janet_checktype(kv->key, JANET_NIL)) return kv;
kv++;
}
return NULL;
}
/* Convert struct to table */
DstTable *dst_struct_to_table(const DstKV *st) {
DstTable *table = dst_table(dst_struct_capacity(st));
JanetTable *janet_struct_to_table(const JanetKV *st) {
JanetTable *table = janet_table(janet_struct_capacity(st));
int32_t i;
for (i = 0; i < dst_struct_capacity(st); i++) {
const DstKV *kv = st + i;
if (!dst_checktype(kv->key, DST_NIL)) {
dst_table_put(table, kv->key, kv->value);
for (i = 0; i < janet_struct_capacity(st); i++) {
const JanetKV *kv = st + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(table, kv->key, kv->value);
}
}
return table;
}
/* Check if two structs are equal */
int dst_struct_equal(const DstKV *lhs, const DstKV *rhs) {
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
int32_t index;
int32_t llen = dst_struct_capacity(lhs);
int32_t rlen = dst_struct_capacity(rhs);
int32_t lhash = dst_struct_hash(lhs);
int32_t rhash = dst_struct_hash(rhs);
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
if (llen != rlen)
return 0;
if (lhash != rhash)
return 0;
for (index = 0; index < llen; index++) {
const DstKV *l = lhs + index;
const DstKV *r = rhs + index;
if (!dst_equals(l->key, r->key))
const JanetKV *l = lhs + index;
const JanetKV *r = rhs + index;
if (!janet_equals(l->key, r->key))
return 0;
if (!dst_equals(l->value, r->value))
if (!janet_equals(l->value, r->value))
return 0;
}
return 1;
}
/* Compare structs */
int dst_struct_compare(const DstKV *lhs, const DstKV *rhs) {
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
int32_t i;
int32_t lhash = dst_struct_hash(lhs);
int32_t rhash = dst_struct_hash(rhs);
int32_t llen = dst_struct_capacity(lhs);
int32_t rlen = dst_struct_capacity(rhs);
int32_t lhash = janet_struct_hash(lhs);
int32_t rhash = janet_struct_hash(rhs);
int32_t llen = janet_struct_capacity(lhs);
int32_t rlen = janet_struct_capacity(rhs);
if (llen < rlen)
return -1;
if (llen > rlen)
@ -221,14 +221,14 @@ int dst_struct_compare(const DstKV *lhs, const DstKV *rhs) {
if (lhash > rhash)
return 1;
for (i = 0; i < llen; ++i) {
const DstKV *l = lhs + i;
const DstKV *r = rhs + i;
int comp = dst_compare(l->key, r->key);
const JanetKV *l = lhs + i;
const JanetKV *r = rhs + i;
int comp = janet_compare(l->key, r->key);
if (comp != 0) return comp;
comp = dst_compare(l->value, r->value);
comp = janet_compare(l->value, r->value);
if (comp != 0) return comp;
}
return 0;
}
#undef dst_struct_maphash
#undef janet_struct_maphash

144
src/core/symcache.c
View File

@ -25,44 +25,44 @@
* checks, all symbols are interned so that there is a single copy of it in the
* whole program. Equality is then just a pointer check. */
#include <dst/dst.h>
#include <janet/janet.h>
#include "state.h"
#include "gc.h"
#include "util.h"
/* Cache state */
DST_THREAD_LOCAL const uint8_t **dst_vm_cache = NULL;
DST_THREAD_LOCAL uint32_t dst_vm_cache_capacity = 0;
DST_THREAD_LOCAL uint32_t dst_vm_cache_count = 0;
DST_THREAD_LOCAL uint32_t dst_vm_cache_deleted = 0;
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0;
JANET_THREAD_LOCAL uint32_t janet_vm_cache_count = 0;
JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
/* Initialize the cache (allocate cache memory) */
void dst_symcache_init() {
dst_vm_cache_capacity = 1024;
dst_vm_cache = calloc(1, dst_vm_cache_capacity * sizeof(const uint8_t **));
if (NULL == dst_vm_cache) {
DST_OUT_OF_MEMORY;
void janet_symcache_init() {
janet_vm_cache_capacity = 1024;
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t **));
if (NULL == janet_vm_cache) {
JANET_OUT_OF_MEMORY;
}
dst_vm_cache_count = 0;
dst_vm_cache_deleted = 0;
janet_vm_cache_count = 0;
janet_vm_cache_deleted = 0;
}
/* Deinitialize the cache (free the cache memory) */
void dst_symcache_deinit() {
free((void *)dst_vm_cache);
dst_vm_cache = NULL;
dst_vm_cache_capacity = 0;
dst_vm_cache_count = 0;
dst_vm_cache_deleted = 0;
void janet_symcache_deinit() {
free((void *)janet_vm_cache);
janet_vm_cache = NULL;
janet_vm_cache_capacity = 0;
janet_vm_cache_count = 0;
janet_vm_cache_deleted = 0;
}
/* Mark an entry in the table as deleted. */
#define DST_SYMCACHE_DELETED ((const uint8_t *)0 + 1)
#define JANET_SYMCACHE_DELETED ((const uint8_t *)0 + 1)
/* Find an item in the cache and return its location.
* If the item is not found, return the location
* where one would put it. */
static const uint8_t **dst_symcache_findmem(
static const uint8_t **janet_symcache_findmem(
const uint8_t *str,
int32_t len,
int32_t hash,
@ -73,35 +73,35 @@ static const uint8_t **dst_symcache_findmem(
/* We will search two ranges - index to the end,
* and 0 to the index. */
index = (uint32_t)hash & (dst_vm_cache_capacity - 1);
index = (uint32_t)hash & (janet_vm_cache_capacity - 1);
bounds[0] = index;
bounds[1] = dst_vm_cache_capacity;
bounds[1] = janet_vm_cache_capacity;
bounds[2] = 0;
bounds[3] = index;
for (j = 0; j < 4; j += 2)
for (i = bounds[j]; i < bounds[j+1]; ++i) {
const uint8_t *test = dst_vm_cache[i];
const uint8_t *test = janet_vm_cache[i];
/* Check empty spots */
if (NULL == test) {
if (NULL == firstEmpty)
firstEmpty = dst_vm_cache + i;
firstEmpty = janet_vm_cache + i;
goto notfound;
}
/* Check for marked deleted */
if (DST_SYMCACHE_DELETED == test) {
if (JANET_SYMCACHE_DELETED == test) {
if (firstEmpty == NULL)
firstEmpty = dst_vm_cache + i;
firstEmpty = janet_vm_cache + i;
continue;
}
if (dst_string_equalconst(test, str, len, hash)) {
if (janet_string_equalconst(test, str, len, hash)) {
/* Replace first deleted */
*success = 1;
if (firstEmpty != NULL) {
*firstEmpty = test;
dst_vm_cache[i] = DST_SYMCACHE_DELETED;
janet_vm_cache[i] = JANET_SYMCACHE_DELETED;
return firstEmpty;
}
return dst_vm_cache + i;
return janet_vm_cache + i;
}
}
notfound:
@ -109,28 +109,28 @@ static const uint8_t **dst_symcache_findmem(
return firstEmpty;
}
#define dst_symcache_find(str, success) \
dst_symcache_findmem((str), dst_string_length(str), dst_string_hash(str), (success))
#define janet_symcache_find(str, success) \
janet_symcache_findmem((str), janet_string_length(str), janet_string_hash(str), (success))
/* Resize the cache. */
static void dst_cache_resize(uint32_t newCapacity) {
static void janet_cache_resize(uint32_t newCapacity) {
uint32_t i, oldCapacity;
const uint8_t **oldCache = dst_vm_cache;
const uint8_t **oldCache = janet_vm_cache;
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t **));
if (newCache == NULL) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
oldCapacity = dst_vm_cache_capacity;
dst_vm_cache = newCache;
dst_vm_cache_capacity = newCapacity;
dst_vm_cache_deleted = 0;
oldCapacity = janet_vm_cache_capacity;
janet_vm_cache = newCache;
janet_vm_cache_capacity = newCapacity;
janet_vm_cache_deleted = 0;
/* Add all of the old cache entries back */
for (i = 0; i < oldCapacity; ++i) {
int status;
const uint8_t **bucket;
const uint8_t *x = oldCache[i];
if (x != NULL && x != DST_SYMCACHE_DELETED) {
bucket = dst_symcache_find(x, &status);
if (x != NULL && x != JANET_SYMCACHE_DELETED) {
bucket = janet_symcache_find(x, &status);
if (status || bucket == NULL) {
/* there was a problem with the algorithm. */
break;
@ -143,66 +143,66 @@ static void dst_cache_resize(uint32_t newCapacity) {
}
/* Add an item to the cache */
static void dst_symcache_put(const uint8_t *x, const uint8_t **bucket) {
if ((dst_vm_cache_count + dst_vm_cache_deleted) * 2 > dst_vm_cache_capacity) {
static void janet_symcache_put(const uint8_t *x, const uint8_t **bucket) {
if ((janet_vm_cache_count + janet_vm_cache_deleted) * 2 > janet_vm_cache_capacity) {
int status;
dst_cache_resize(dst_tablen((2 * dst_vm_cache_count + 1)));
bucket = dst_symcache_find(x, &status);
janet_cache_resize(janet_tablen((2 * janet_vm_cache_count + 1)));
bucket = janet_symcache_find(x, &status);
}
/* Add x to the cache */
dst_vm_cache_count++;
janet_vm_cache_count++;
*bucket = x;
}
/* Remove a symbol from the symcache */
void dst_symbol_deinit(const uint8_t *sym) {
void janet_symbol_deinit(const uint8_t *sym) {
int status = 0;
const uint8_t **bucket = dst_symcache_find(sym, &status);
const uint8_t **bucket = janet_symcache_find(sym, &status);
if (status) {
dst_vm_cache_count--;
dst_vm_cache_deleted++;
*bucket = DST_SYMCACHE_DELETED;
janet_vm_cache_count--;
janet_vm_cache_deleted++;
*bucket = JANET_SYMCACHE_DELETED;
}
}
/* Create a symbol from a byte string */
const uint8_t *dst_symbol(const uint8_t *str, int32_t len) {
int32_t hash = dst_string_calchash(str, len);
const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
int32_t hash = janet_string_calchash(str, len);
uint8_t *newstr;
int success = 0;
const uint8_t **bucket = dst_symcache_findmem(str, len, hash, &success);
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
if (success)
return *bucket;
newstr = (uint8_t *) dst_gcalloc(DST_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
+ (2 * sizeof(int32_t));
dst_string_hash(newstr) = hash;
dst_string_length(newstr) = len;
janet_string_hash(newstr) = hash;
janet_string_length(newstr) = len;
memcpy(newstr, str, len);
newstr[len] = 0;
dst_symcache_put((const uint8_t *)newstr, bucket);
janet_symcache_put((const uint8_t *)newstr, bucket);
return newstr;
}
/* Get a symbol from a cstring */
const uint8_t *dst_csymbol(const char *cstr) {
const uint8_t *janet_csymbol(const char *cstr) {
int32_t len = 0;
while (cstr[len]) len++;
return dst_symbol((const uint8_t *)cstr, len);
return janet_symbol((const uint8_t *)cstr, len);
}
/* Convert a string to a symbol */
const uint8_t *dst_symbol_from_string(const uint8_t *str) {
const uint8_t *janet_symbol_from_string(const uint8_t *str) {
int success = 0;
const uint8_t **bucket = dst_symcache_find(str, &success);
const uint8_t **bucket = janet_symcache_find(str, &success);
if (success)
return *bucket;
dst_symcache_put((const uint8_t *)str, bucket);
dst_gc_settype(dst_string_raw(str), DST_MEMORY_SYMBOL);
janet_symcache_put((const uint8_t *)str, bucket);
janet_gc_settype(janet_string_raw(str), JANET_MEMORY_SYMBOL);
return str;
}
/* Store counter for genysm to avoid quadratic behavior */
DST_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
JANET_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
/* Increment the gensym buffer */
static void inc_gensym(void) {
@ -225,7 +225,7 @@ static void inc_gensym(void) {
/* Generate a unique symbol. This is used in the library function gensym. The
* symbol will be of the format _XXXXXX, where X is a base64 digit, and
* prefix is the argument passed. No prefix for speed. */
const uint8_t *dst_symbol_gen(void) {
const uint8_t *janet_symbol_gen(void) {
const uint8_t **bucket = NULL;
uint8_t *sym;
int32_t hash = 0;
@ -233,22 +233,22 @@ const uint8_t *dst_symbol_gen(void) {
/* Leave spaces for 6 base 64 digits and two dashes. That means 64^6 possible suffixes, which
* is enough for resolving collisions. */
do {
hash = dst_string_calchash(
hash = janet_string_calchash(
gensym_counter,
sizeof(gensym_counter) - 1);
bucket = dst_symcache_findmem(
bucket = janet_symcache_findmem(
gensym_counter,
sizeof(gensym_counter) - 1,
hash,
&status);
} while (status && (inc_gensym(), 1));
sym = (uint8_t *) dst_gcalloc(
DST_MEMORY_SYMBOL,
sym = (uint8_t *) janet_gcalloc(
JANET_MEMORY_SYMBOL,
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
(2 * sizeof(int32_t));
memcpy(sym, gensym_counter, sizeof(gensym_counter));
dst_string_length(sym) = sizeof(gensym_counter) - 1;
dst_string_hash(sym) = hash;
dst_symcache_put((const uint8_t *)sym, bucket);
janet_string_length(sym) = sizeof(gensym_counter) - 1;
janet_string_hash(sym) = hash;
janet_symcache_put((const uint8_t *)sym, bucket);
return (const uint8_t *)sym;
}

12
src/core/symcache.h
View File

@ -20,14 +20,14 @@
* IN THE SOFTWARE.
*/
#ifndef DST_SYMCACHE_H_defined
#define DST_SYMCACHE_H_defined
#ifndef JANET_SYMCACHE_H_defined
#define JANET_SYMCACHE_H_defined
#include <dst/dst.h>
#include <janet/janet.h>
/* Initialize the cache (allocate cache memory) */
void dst_symcache_init(void);
void dst_symcache_deinit(void);
void dst_symbol_deinit(const uint8_t *sym);
void janet_symcache_init(void);
void janet_symcache_deinit(void);
void janet_symbol_deinit(const uint8_t *sym);
#endif

224
src/core/table.c
View File

@ -20,20 +20,20 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "gc.h"
#include "util.h"
#define dst_table_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
#define janet_table_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
/* Initialize a table */
DstTable *dst_table_init(DstTable *table, int32_t capacity) {
DstKV *data;
capacity = dst_tablen(capacity);
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
JanetKV *data;
capacity = janet_tablen(capacity);
if (capacity) {
data = (DstKV *) dst_memalloc_empty(capacity);
data = (JanetKV *) janet_memalloc_empty(capacity);
if (NULL == data) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
table->data = data;
table->capacity = capacity;
@ -48,45 +48,45 @@ DstTable *dst_table_init(DstTable *table, int32_t capacity) {
}
/* Deinitialize a table */
void dst_table_deinit(DstTable *table) {
void janet_table_deinit(JanetTable *table) {
free(table->data);
}
/* Create a new table */
DstTable *dst_table(int32_t capacity) {
DstTable *table = dst_gcalloc(DST_MEMORY_TABLE, sizeof(DstTable));
return dst_table_init(table, capacity);
JanetTable *janet_table(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
return janet_table_init(table, capacity);
}
/* Find the bucket that contains the given key. Will also return
* bucket where key should go if not in the table. */
DstKV *dst_table_find(DstTable *t, Dst key) {
int32_t index = dst_table_maphash(t->capacity, dst_hash(key));
JanetKV *janet_table_find(JanetTable *t, Janet key) {
int32_t index = janet_table_maphash(t->capacity, janet_hash(key));
int32_t i;
DstKV *first_bucket = NULL;
JanetKV *first_bucket = NULL;
/* Higher half */
for (i = index; i < t->capacity; i++) {
DstKV *kv = t->data + i;
if (dst_checktype(kv->key, DST_NIL)) {
if (dst_checktype(kv->value, DST_NIL)) {
JanetKV *kv = t->data + i;
if (janet_checktype(kv->key, JANET_NIL)) {
if (janet_checktype(kv->value, JANET_NIL)) {
return kv;
} else if (NULL == first_bucket) {
first_bucket = kv;
}
} else if (dst_equals(kv->key, key)) {
} else if (janet_equals(kv->key, key)) {
return t->data + i;
}
}
/* Lower half */
for (i = 0; i < index; i++) {
DstKV *kv = t->data + i;
if (dst_checktype(kv->key, DST_NIL)) {
if (dst_checktype(kv->value, DST_NIL)) {
JanetKV *kv = t->data + i;
if (janet_checktype(kv->key, JANET_NIL)) {
if (janet_checktype(kv->value, JANET_NIL)) {
return kv;
} else if (NULL == first_bucket) {
first_bucket = kv;
}
} else if (dst_equals(kv->key, key)) {
} else if (janet_equals(kv->key, key)) {
return t->data + i;
}
}
@ -94,11 +94,11 @@ DstKV *dst_table_find(DstTable *t, Dst key) {
}
/* Resize the dictionary table. */
static void dst_table_rehash(DstTable *t, int32_t size) {
DstKV *olddata = t->data;
DstKV *newdata = (DstKV *) dst_memalloc_empty(size);
static void janet_table_rehash(JanetTable *t, int32_t size) {
JanetKV *olddata = t->data;
JanetKV *newdata = (JanetKV *) janet_memalloc_empty(size);
if (NULL == newdata) {
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
int32_t i, oldcapacity;
oldcapacity = t->capacity;
@ -106,9 +106,9 @@ static void dst_table_rehash(DstTable *t, int32_t size) {
t->capacity = size;
t->deleted = 0;
for (i = 0; i < oldcapacity; i++) {
DstKV *kv = olddata + i;
if (!dst_checktype(kv->key, DST_NIL)) {
DstKV *newkv = dst_table_find(t, kv->key);
JanetKV *kv = olddata + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
JanetKV *newkv = janet_table_find(t, kv->key);
*newkv = *kv;
}
}
@ -116,62 +116,62 @@ static void dst_table_rehash(DstTable *t, int32_t size) {
}
/* Get a value out of the table */
Dst dst_table_get(DstTable *t, Dst key) {
DstKV *bucket = dst_table_find(t, key);
if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL))
Janet janet_table_get(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
/* Check prototypes */
{
int i;
for (i = DST_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
bucket = dst_table_find(t, key);
if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL))
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
}
}
return dst_wrap_nil();
return janet_wrap_nil();
}
/* Get a value out of the table. Don't check prototype tables. */
Dst dst_table_rawget(DstTable *t, Dst key) {
DstKV *bucket = dst_table_find(t, key);
if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL))
Janet janet_table_rawget(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
else
return dst_wrap_nil();
return janet_wrap_nil();
}
/* Remove an entry from the dictionary. Return the value that
* was removed. */
Dst dst_table_remove(DstTable *t, Dst key) {
DstKV *bucket = dst_table_find(t, key);
if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL)) {
Dst ret = bucket->key;
Janet janet_table_remove(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
Janet ret = bucket->key;
t->count--;
t->deleted++;
bucket->key = dst_wrap_nil();
bucket->value = dst_wrap_false();
bucket->key = janet_wrap_nil();
bucket->value = janet_wrap_false();
return ret;
} else {
return dst_wrap_nil();
return janet_wrap_nil();
}
}
/* Put a value into the object */
void dst_table_put(DstTable *t, Dst key, Dst value) {
if (dst_checktype(key, DST_NIL)) return;
if (dst_checktype(value, DST_NIL)) {
dst_table_remove(t, key);
void janet_table_put(JanetTable *t, Janet key, Janet value) {
if (janet_checktype(key, JANET_NIL)) return;
if (janet_checktype(value, JANET_NIL)) {
janet_table_remove(t, key);
} else {
DstKV *bucket = dst_table_find(t, key);
if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL)) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
bucket->value = value;
} else {
if (NULL == bucket || 2 * (t->count + t->deleted + 1) > t->capacity) {
dst_table_rehash(t, dst_tablen(2 * t->count + 2));
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
}
bucket = dst_table_find(t, key);
if (dst_checktype(bucket->value, DST_FALSE))
bucket = janet_table_find(t, key);
if (janet_checktype(bucket->value, JANET_FALSE))
--t->deleted;
bucket->key = key;
bucket->value = value;
@ -181,20 +181,20 @@ void dst_table_put(DstTable *t, Dst key, Dst value) {
}
/* Clear a table */
void dst_table_clear(DstTable *t) {
void janet_table_clear(JanetTable *t) {
int32_t capacity = t->capacity;
DstKV *data = t->data;
dst_memempty(data, capacity);
JanetKV *data = t->data;
janet_memempty(data, capacity);
t->count = 0;
t->deleted = 0;
}
/* Find next key in an object. Returns NULL if no next key. */
const DstKV *dst_table_next(DstTable *t, const DstKV *kv) {
DstKV *end = t->data + t->capacity;
const JanetKV *janet_table_next(JanetTable *t, const JanetKV *kv) {
JanetKV *end = t->data + t->capacity;
kv = (kv == NULL) ? t->data : kv + 1;
while (kv < end) {
if (!dst_checktype(kv->key, DST_NIL))
if (!janet_checktype(kv->key, JANET_NIL))
return kv;
kv++;
}
@ -202,87 +202,87 @@ const DstKV *dst_table_next(DstTable *t, const DstKV *kv) {
}
/* Convert table to struct */
const DstKV *dst_table_to_struct(DstTable *t) {
DstKV *st = dst_struct_begin(t->count);
DstKV *kv = t->data;
DstKV *end = t->data + t->capacity;
const JanetKV *janet_table_to_struct(JanetTable *t) {
JanetKV *st = janet_struct_begin(t->count);
JanetKV *kv = t->data;
JanetKV *end = t->data + t->capacity;
while (kv < end) {
if (!dst_checktype(kv->key, DST_NIL))
dst_struct_put(st, kv->key, kv->value);
if (!janet_checktype(kv->key, JANET_NIL))
janet_struct_put(st, kv->key, kv->value);
kv++;
}
return dst_struct_end(st);
return janet_struct_end(st);
}
/* Merge a table or struct into a table */
static void dst_table_mergekv(DstTable *table, const DstKV *kvs, int32_t cap) {
static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t cap) {
int32_t i;
for (i = 0; i < cap; i++) {
const DstKV *kv = kvs + i;
if (!dst_checktype(kv->key, DST_NIL)) {
dst_table_put(table, kv->key, kv->value);
const JanetKV *kv = kvs + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(table, kv->key, kv->value);
}
}
}
/* Merge a table other into another table */
void dst_table_merge_table(DstTable *table, DstTable *other) {
dst_table_mergekv(table, other->data, other->capacity);
void janet_table_merge_table(JanetTable *table, JanetTable *other) {
janet_table_mergekv(table, other->data, other->capacity);
}
/* Merge a struct into a table */
void dst_table_merge_struct(DstTable *table, const DstKV *other) {
dst_table_mergekv(table, other, dst_struct_capacity(other));
void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
janet_table_mergekv(table, other, janet_struct_capacity(other));
}
/* C Functions */
static int cfun_new(DstArgs args) {
DstTable *t;
static int cfun_new(JanetArgs args) {
JanetTable *t;
int32_t cap;
DST_FIXARITY(args, 1);
DST_ARG_INTEGER(cap, args, 0);
t = dst_table(cap);
DST_RETURN_TABLE(args, t);
JANET_FIXARITY(args, 1);
JANET_ARG_INTEGER(cap, args, 0);
t = janet_table(cap);
JANET_RETURN_TABLE(args, t);
}
static int cfun_getproto(DstArgs args) {
DstTable *t;
DST_FIXARITY(args, 1);
DST_ARG_TABLE(t, args, 0);
DST_RETURN(args, t->proto
? dst_wrap_table(t->proto)
: dst_wrap_nil());
static int cfun_getproto(JanetArgs args) {
JanetTable *t;
JANET_FIXARITY(args, 1);
JANET_ARG_TABLE(t, args, 0);
JANET_RETURN(args, t->proto
? janet_wrap_table(t->proto)
: janet_wrap_nil());
}
static int cfun_setproto(DstArgs args) {
DstTable *table, *proto;
DST_FIXARITY(args, 2);
DST_ARG_TABLE(table, args, 0);
if (dst_checktype(args.v[1], DST_NIL)) {
static int cfun_setproto(JanetArgs args) {
JanetTable *table, *proto;
JANET_FIXARITY(args, 2);
JANET_ARG_TABLE(table, args, 0);
if (janet_checktype(args.v[1], JANET_NIL)) {
proto = NULL;
} else {
DST_ARG_TABLE(proto, args, 1);
JANET_ARG_TABLE(proto, args, 1);
}
table->proto = proto;
DST_RETURN_TABLE(args, table);
JANET_RETURN_TABLE(args, table);
}
static int cfun_tostruct(DstArgs args) {
DstTable *t;
DST_FIXARITY(args, 1);
DST_ARG_TABLE(t, args, 0);
DST_RETURN_STRUCT(args, dst_table_to_struct(t));
static int cfun_tostruct(JanetArgs args) {
JanetTable *t;
JANET_FIXARITY(args, 1);
JANET_ARG_TABLE(t, args, 0);
JANET_RETURN_STRUCT(args, janet_table_to_struct(t));
}
static int cfun_rawget(DstArgs args) {
DstTable *table;
DST_FIXARITY(args, 2);
DST_ARG_TABLE(table, args, 0);
DST_RETURN(args, dst_table_rawget(table, args.v[1]));
static int cfun_rawget(JanetArgs args) {
JanetTable *table;
JANET_FIXARITY(args, 2);
JANET_ARG_TABLE(table, args, 0);
JANET_RETURN(args, janet_table_rawget(table, args.v[1]));
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"table.new", cfun_new},
{"table.to-struct", cfun_tostruct},
{"table.getproto", cfun_getproto},
@ -292,10 +292,10 @@ static const DstReg cfuns[] = {
};
/* Load the table module */
int dst_lib_table(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_table(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}
#undef dst_table_maphash
#undef janet_table_maphash

124
src/core/tuple.c
View File

@ -20,66 +20,66 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "symcache.h"
#include "gc.h"
#include "util.h"
/* Create a new empty tuple of the given size. This will return memory
* which should be filled with Dsts. The memory will not be collected until
* dst_tuple_end is called. */
Dst *dst_tuple_begin(int32_t length) {
char *data = dst_gcalloc(DST_MEMORY_TUPLE, 4 * sizeof(int32_t) + length * sizeof(Dst));
Dst *tuple = (Dst *)(data + (4 * sizeof(int32_t)));
dst_tuple_length(tuple) = length;
dst_tuple_sm_line(tuple) = 0;
dst_tuple_sm_col(tuple) = 0;
* which should be filled with Janets. The memory will not be collected until
* janet_tuple_end is called. */
Janet *janet_tuple_begin(int32_t length) {
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 4 * sizeof(int32_t) + length * sizeof(Janet));
Janet *tuple = (Janet *)(data + (4 * sizeof(int32_t)));
janet_tuple_length(tuple) = length;
janet_tuple_sm_line(tuple) = 0;
janet_tuple_sm_col(tuple) = 0;
return tuple;
}
/* Finish building a tuple */
const Dst *dst_tuple_end(Dst *tuple) {
dst_tuple_hash(tuple) = dst_array_calchash(tuple, dst_tuple_length(tuple));
return (const Dst *)tuple;
const Janet *janet_tuple_end(Janet *tuple) {
janet_tuple_hash(tuple) = janet_array_calchash(tuple, janet_tuple_length(tuple));
return (const Janet *)tuple;
}
/* Build a tuple with n values */
const Dst *dst_tuple_n(const Dst *values, int32_t n) {
Dst *t = dst_tuple_begin(n);
memcpy(t, values, sizeof(Dst) * n);
return dst_tuple_end(t);
const Janet *janet_tuple_n(const Janet *values, int32_t n) {
Janet *t = janet_tuple_begin(n);
memcpy(t, values, sizeof(Janet) * n);
return janet_tuple_end(t);
}
/* Check if two tuples are equal */
int dst_tuple_equal(const Dst *lhs, const Dst *rhs) {
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
int32_t index;
int32_t llen = dst_tuple_length(lhs);
int32_t rlen = dst_tuple_length(rhs);
int32_t lhash = dst_tuple_hash(lhs);
int32_t rhash = dst_tuple_hash(rhs);
int32_t llen = janet_tuple_length(lhs);
int32_t rlen = janet_tuple_length(rhs);
int32_t lhash = janet_tuple_hash(lhs);
int32_t rhash = janet_tuple_hash(rhs);
if (lhash == 0)
lhash = dst_tuple_hash(lhs) = dst_array_calchash(lhs, llen);
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
if (rhash == 0)
rhash = dst_tuple_hash(rhs) = dst_array_calchash(rhs, rlen);
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
if (lhash != rhash)
return 0;
if (llen != rlen)
return 0;
for (index = 0; index < llen; index++) {
if (!dst_equals(lhs[index], rhs[index]))
if (!janet_equals(lhs[index], rhs[index]))
return 0;
}
return 1;
}
/* Compare tuples */
int dst_tuple_compare(const Dst *lhs, const Dst *rhs) {
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
int32_t i;
int32_t llen = dst_tuple_length(lhs);
int32_t rlen = dst_tuple_length(rhs);
int32_t llen = janet_tuple_length(lhs);
int32_t rlen = janet_tuple_length(rhs);
int32_t count = llen < rlen ? llen : rlen;
for (i = 0; i < count; ++i) {
int comp = dst_compare(lhs[i], rhs[i]);
int comp = janet_compare(lhs[i], rhs[i]);
if (comp != 0) return comp;
}
if (llen < rlen)
@ -91,68 +91,68 @@ int dst_tuple_compare(const Dst *lhs, const Dst *rhs) {
/* C Functions */
static int cfun_slice(DstArgs args) {
const Dst *vals;
static int cfun_slice(JanetArgs args) {
const Janet *vals;
int32_t len;
Dst *ret;
Janet *ret;
int32_t start, end;
DST_MINARITY(args, 1);
if (!dst_indexed_view(args.v[0], &vals, &len)) DST_THROW(args, "expected array/tuple");
JANET_MINARITY(args, 1);
if (!janet_indexed_view(args.v[0], &vals, &len)) JANET_THROW(args, "expected array/tuple");
/* Get start */
if (args.n < 2) {
start = 0;
} else if (dst_checktype(args.v[1], DST_INTEGER)) {
start = dst_unwrap_integer(args.v[1]);
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
DST_THROW(args, "expected integer");
JANET_THROW(args, "expected integer");
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (dst_checktype(args.v[2], DST_INTEGER)) {
end = dst_unwrap_integer(args.v[2]);
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
DST_THROW(args, "expected integer");
JANET_THROW(args, "expected integer");
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;
if (end >= start) {
int32_t i, j;
ret = dst_tuple_begin(end - start);
ret = janet_tuple_begin(end - start);
for (j = 0, i = start; i < end; j++, i++) {
ret[j] = vals[i];
}
} else {
ret = dst_tuple_begin(0);
ret = janet_tuple_begin(0);
}
DST_RETURN_TUPLE(args, dst_tuple_end(ret));
JANET_RETURN_TUPLE(args, janet_tuple_end(ret));
}
static int cfun_prepend(DstArgs args) {
const Dst *t;
static int cfun_prepend(JanetArgs args) {
const Janet *t;
int32_t len;
Dst *n;
DST_FIXARITY(args, 2);
if (!dst_indexed_view(args.v[0], &t, &len)) DST_THROW(args, "expected tuple/array");
n = dst_tuple_begin(len + 1);
memcpy(n + 1, t, sizeof(Dst) * len);
Janet *n;
JANET_FIXARITY(args, 2);
if (!janet_indexed_view(args.v[0], &t, &len)) JANET_THROW(args, "expected tuple/array");
n = janet_tuple_begin(len + 1);
memcpy(n + 1, t, sizeof(Janet) * len);
n[0] = args.v[1];
DST_RETURN_TUPLE(args, dst_tuple_end(n));
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
}
static int cfun_append(DstArgs args) {
const Dst *t;
static int cfun_append(JanetArgs args) {
const Janet *t;
int32_t len;
Dst *n;
DST_FIXARITY(args, 2);
if (!dst_indexed_view(args.v[0], &t, &len)) DST_THROW(args, "expected tuple/array");
n = dst_tuple_begin(len + 1);
memcpy(n, t, sizeof(Dst) * len);
Janet *n;
JANET_FIXARITY(args, 2);
if (!janet_indexed_view(args.v[0], &t, &len)) JANET_THROW(args, "expected tuple/array");
n = janet_tuple_begin(len + 1);
memcpy(n, t, sizeof(Janet) * len);
n[len] = args.v[1];
DST_RETURN_TUPLE(args, dst_tuple_end(n));
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
}
static const DstReg cfuns[] = {
static const JanetReg cfuns[] = {
{"tuple.slice", cfun_slice},
{"tuple.append", cfun_append},
{"tuple.prepend", cfun_prepend},
@ -160,8 +160,8 @@ static const DstReg cfuns[] = {
};
/* Load the tuple module */
int dst_lib_tuple(DstArgs args) {
DstTable *env = dst_env(args);
dst_cfuns(env, NULL, cfuns);
int janet_lib_tuple(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
return 0;
}

230
src/core/util.c
View File

@ -20,21 +20,21 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include "util.h"
#include "state.h"
#include "gc.h"
/* Base 64 lookup table for digits */
const char dst_base64[65] =
const char janet_base64[65] =
"0123456789"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"abcdefghijklmnopqrstuvwxyz"
"_=";
/* The DST value types in order. These types can be used as
/* The JANET value types in order. These types can be used as
* mnemonics instead of a bit pattern for type checking */
const char *const dst_type_names[16] = {
const char *const janet_type_names[16] = {
":nil",
":boolean",
":boolean",
@ -55,7 +55,7 @@ const char *const dst_type_names[16] = {
/* Calculate hash for string */
int32_t dst_string_calchash(const uint8_t *str, int32_t len) {
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
const uint8_t *end = str + len;
uint32_t hash = 5381;
while (str < end)
@ -64,21 +64,21 @@ int32_t dst_string_calchash(const uint8_t *str, int32_t len) {
}
/* Computes hash of an array of values */
int32_t dst_array_calchash(const Dst *array, int32_t len) {
const Dst *end = array + len;
int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len;
uint32_t hash = 5381;
while (array < end)
hash = (hash << 5) + hash + dst_hash(*array++);
hash = (hash << 5) + hash + janet_hash(*array++);
return (int32_t) hash;
}
/* Computes hash of an array of values */
int32_t dst_kv_calchash(const DstKV *kvs, int32_t len) {
const DstKV *end = kvs + len;
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
const JanetKV *end = kvs + len;
uint32_t hash = 5381;
while (kvs < end) {
hash = (hash << 5) + hash + dst_hash(kvs->key);
hash = (hash << 5) + hash + dst_hash(kvs->value);
hash = (hash << 5) + hash + janet_hash(kvs->key);
hash = (hash << 5) + hash + janet_hash(kvs->value);
kvs++;
}
return (int32_t) hash;
@ -86,7 +86,7 @@ int32_t dst_kv_calchash(const DstKV *kvs, int32_t len) {
/* Calculate next power of 2. May overflow. If n is 0,
* will return 0. */
int32_t dst_tablen(int32_t n) {
int32_t janet_tablen(int32_t n) {
n |= n >> 1;
n |= n >> 2;
n |= n >> 4;
@ -95,10 +95,10 @@ int32_t dst_tablen(int32_t n) {
return n + 1;
}
/* Compare a dst string with a cstring. more efficient than loading
* c string as a dst string. */
int dst_cstrcmp(const uint8_t *str, const char *other) {
int32_t len = dst_string_length(str);
/* Compare a janet string with a cstring. more efficient than loading
* c string as a janet string. */
int janet_cstrcmp(const uint8_t *str, const char *other) {
int32_t len = janet_string_length(str);
int32_t index;
for (index = 0; index < len; index++) {
uint8_t c = str[index];
@ -113,7 +113,7 @@ int dst_cstrcmp(const uint8_t *str, const char *other) {
/* Do a binary search on a static array of structs. Each struct must
* have a string as its first element, and the struct must be sorted
* lexogrpahically by that element. */
const void *dst_strbinsearch(
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,
size_t itemsize,
@ -125,7 +125,7 @@ const void *dst_strbinsearch(
size_t mid = low + ((hi - low) / 2);
const char **item = (const char **)(t + mid * itemsize);
const char *name = *item;
int comp = dst_cstrcmp(key, name);
int comp = janet_cstrcmp(key, name);
if (comp < 0) {
hi = mid;
} else if (comp > 0) {
@ -138,98 +138,98 @@ const void *dst_strbinsearch(
}
/* Register a value in the global registry */
void dst_register(const char *name, Dst value) {
Dst regkey = dst_csymbolv(name);
dst_table_put(dst_vm_registry, regkey, value);
dst_table_put(dst_vm_registry, value, regkey);
void janet_register(const char *name, Janet value) {
Janet regkey = janet_csymbolv(name);
janet_table_put(janet_vm_registry, regkey, value);
janet_table_put(janet_vm_registry, value, regkey);
}
/* Add a def to an environment */
void dst_def(DstTable *env, const char *name, Dst val) {
DstTable *subt = dst_table(1);
dst_table_put(subt, dst_csymbolv(":value"), val);
dst_table_put(env, dst_csymbolv(name), dst_wrap_table(subt));
void janet_def(JanetTable *env, const char *name, Janet val) {
JanetTable *subt = janet_table(1);
janet_table_put(subt, janet_csymbolv(":value"), val);
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
}
/* Add a var to the environment */
void dst_var(DstTable *env, const char *name, Dst val) {
DstArray *array = dst_array(1);
DstTable *subt = dst_table(1);
dst_array_push(array, val);
dst_table_put(subt, dst_csymbolv(":ref"), dst_wrap_array(array));
dst_table_put(env, dst_csymbolv(name), dst_wrap_table(subt));
void janet_var(JanetTable *env, const char *name, Janet val) {
JanetArray *array = janet_array(1);
JanetTable *subt = janet_table(1);
janet_array_push(array, val);
janet_table_put(subt, janet_csymbolv(":ref"), janet_wrap_array(array));
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
}
/* Load many cfunctions at once */
void dst_cfuns(DstTable *env, const char *regprefix, const DstReg *cfuns) {
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
while (cfuns->name) {
Dst name = dst_csymbolv(cfuns->name);
Dst longname = name;
Janet name = janet_csymbolv(cfuns->name);
Janet longname = name;
if (regprefix) {
int32_t reglen = 0;
int32_t nmlen = 0;
while (regprefix[reglen]) reglen++;
while (cfuns->name[nmlen]) nmlen++;
uint8_t *longname_buffer =
dst_string_begin(reglen + 1 + nmlen);
janet_string_begin(reglen + 1 + nmlen);
memcpy(longname_buffer, regprefix, reglen);
longname_buffer[reglen] = '.';
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
longname = dst_wrap_symbol(dst_string_end(longname_buffer));
longname = janet_wrap_symbol(janet_string_end(longname_buffer));
}
Dst fun = dst_wrap_cfunction(cfuns->cfun);
dst_def(env, cfuns->name, fun);
dst_table_put(dst_vm_registry, longname, fun);
dst_table_put(dst_vm_registry, fun, longname);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_def(env, cfuns->name, fun);
janet_table_put(janet_vm_registry, longname, fun);
janet_table_put(janet_vm_registry, fun, longname);
cfuns++;
}
}
/* Resolve a symbol in the environment */
DstBindingType dst_resolve(DstTable *env, const uint8_t *sym, Dst *out) {
Dst ref;
DstTable *entry_table;
Dst entry = dst_table_get(env, dst_wrap_symbol(sym));
if (!dst_checktype(entry, DST_TABLE))
return DST_BINDING_NONE;
entry_table = dst_unwrap_table(entry);
if (!dst_checktype(
dst_table_get(entry_table, dst_csymbolv(":macro")),
DST_NIL)) {
*out = dst_table_get(entry_table, dst_csymbolv(":value"));
return DST_BINDING_MACRO;
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
Janet ref;
JanetTable *entry_table;
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
if (!janet_checktype(entry, JANET_TABLE))
return JANET_BINDING_NONE;
entry_table = janet_unwrap_table(entry);
if (!janet_checktype(
janet_table_get(entry_table, janet_csymbolv(":macro")),
JANET_NIL)) {
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
return JANET_BINDING_MACRO;
}
ref = dst_table_get(entry_table, dst_csymbolv(":ref"));
if (dst_checktype(ref, DST_ARRAY)) {
ref = janet_table_get(entry_table, janet_csymbolv(":ref"));
if (janet_checktype(ref, JANET_ARRAY)) {
*out = ref;
return DST_BINDING_VAR;
return JANET_BINDING_VAR;
}
*out = dst_table_get(entry_table, dst_csymbolv(":value"));
return DST_BINDING_DEF;
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
return JANET_BINDING_DEF;
}
/* Get module from the arguments passed to library */
DstTable *dst_env(DstArgs args) {
DstTable *module;
if (args.n >= 1 && dst_checktype(args.v[0], DST_TABLE)) {
module = dst_unwrap_table(args.v[0]);
JanetTable *janet_env(JanetArgs args) {
JanetTable *module;
if (args.n >= 1 && janet_checktype(args.v[0], JANET_TABLE)) {
module = janet_unwrap_table(args.v[0]);
} else {
module = dst_table(0);
module = janet_table(0);
}
*args.ret = dst_wrap_table(module);
*args.ret = janet_wrap_table(module);
return module;
}
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
* view can be constructed, 0 if an invalid type. */
int dst_indexed_view(Dst seq, const Dst **data, int32_t *len) {
if (dst_checktype(seq, DST_ARRAY)) {
*data = dst_unwrap_array(seq)->data;
*len = dst_unwrap_array(seq)->count;
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
if (janet_checktype(seq, JANET_ARRAY)) {
*data = janet_unwrap_array(seq)->data;
*len = janet_unwrap_array(seq)->count;
return 1;
} else if (dst_checktype(seq, DST_TUPLE)) {
*data = dst_unwrap_tuple(seq);
*len = dst_tuple_length(dst_unwrap_struct(seq));
} else if (janet_checktype(seq, JANET_TUPLE)) {
*data = janet_unwrap_tuple(seq);
*len = janet_tuple_length(janet_unwrap_struct(seq));
return 1;
}
return 0;
@ -237,14 +237,14 @@ int dst_indexed_view(Dst seq, const Dst **data, int32_t *len) {
/* Read both strings and buffer as unsigned character array + int32_t len.
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
int dst_bytes_view(Dst str, const uint8_t **data, int32_t *len) {
if (dst_checktype(str, DST_STRING) || dst_checktype(str, DST_SYMBOL)) {
*data = dst_unwrap_string(str);
*len = dst_string_length(dst_unwrap_string(str));
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL)) {
*data = janet_unwrap_string(str);
*len = janet_string_length(janet_unwrap_string(str));
return 1;
} else if (dst_checktype(str, DST_BUFFER)) {
*data = dst_unwrap_buffer(str)->data;
*len = dst_unwrap_buffer(str)->count;
} else if (janet_checktype(str, JANET_BUFFER)) {
*data = janet_unwrap_buffer(str)->data;
*len = janet_unwrap_buffer(str)->count;
return 1;
}
return 0;
@ -253,39 +253,39 @@ int dst_bytes_view(Dst str, const uint8_t **data, int32_t *len) {
/* Read both structs and tables as the entries of a hashtable with
* identical structure. Returns 1 if the view can be constructed and
* 0 if the type is invalid. */
int dst_dictionary_view(Dst tab, const DstKV **data, int32_t *len, int32_t *cap) {
if (dst_checktype(tab, DST_TABLE)) {
*data = dst_unwrap_table(tab)->data;
*cap = dst_unwrap_table(tab)->capacity;
*len = dst_unwrap_table(tab)->count;
int janet_dictionary_view(Janet tab, const JanetKV **data, int32_t *len, int32_t *cap) {
if (janet_checktype(tab, JANET_TABLE)) {
*data = janet_unwrap_table(tab)->data;
*cap = janet_unwrap_table(tab)->capacity;
*len = janet_unwrap_table(tab)->count;
return 1;
} else if (dst_checktype(tab, DST_STRUCT)) {
*data = dst_unwrap_struct(tab);
*cap = dst_struct_capacity(dst_unwrap_struct(tab));
*len = dst_struct_length(dst_unwrap_struct(tab));
} else if (janet_checktype(tab, JANET_STRUCT)) {
*data = janet_unwrap_struct(tab);
*cap = janet_struct_capacity(janet_unwrap_struct(tab));
*len = janet_struct_length(janet_unwrap_struct(tab));
return 1;
}
return 0;
}
/* Get actual type name of a value for debugging purposes */
static const char *typestr(DstArgs args, int32_t n) {
DstType actual = n < args.n ? dst_type(args.v[n]) : DST_NIL;
return ((actual == DST_ABSTRACT)
? dst_abstract_type(dst_unwrap_abstract(args.v[n]))->name
: dst_type_names[actual]) + 1;
static const char *typestr(JanetArgs args, int32_t n) {
JanetType actual = n < args.n ? janet_type(args.v[n]) : JANET_NIL;
return ((actual == JANET_ABSTRACT)
? janet_abstract_type(janet_unwrap_abstract(args.v[n]))->name
: janet_type_names[actual]) + 1;
}
int dst_type_err(DstArgs args, int32_t n, DstType expected) {
const uint8_t *message = dst_formatc(
int janet_type_err(JanetArgs args, int32_t n, JanetType expected) {
const uint8_t *message = janet_formatc(
"bad slot #%d, expected %t, got %s",
n,
expected,
typestr(args, n));
DST_THROWV(args, dst_wrap_string(message));
JANET_THROWV(args, janet_wrap_string(message));
}
void dst_buffer_push_types(DstBuffer *buffer, int types) {
void janet_buffer_push_types(JanetBuffer *buffer, int types) {
int first = 1;
int i = 0;
while (types) {
@ -293,38 +293,38 @@ void dst_buffer_push_types(DstBuffer *buffer, int types) {
if (first) {
first = 0;
} else {
dst_buffer_push_u8(buffer, '|');
janet_buffer_push_u8(buffer, '|');
}
dst_buffer_push_cstring(buffer, dst_type_names[i] + 1);
janet_buffer_push_cstring(buffer, janet_type_names[i] + 1);
}
i++;
types >>= 1;
}
}
int dst_typemany_err(DstArgs args, int32_t n, int expected) {
int janet_typemany_err(JanetArgs args, int32_t n, int expected) {
const uint8_t *message;
DstBuffer buf;
dst_buffer_init(&buf, 20);
dst_buffer_push_string(&buf, dst_formatc("bad slot #%d, expected ", n));
dst_buffer_push_types(&buf, expected);
dst_buffer_push_cstring(&buf, ", got ");
dst_buffer_push_cstring(&buf, typestr(args, n));
message = dst_string(buf.data, buf.count);
dst_buffer_deinit(&buf);
DST_THROWV(args, dst_wrap_string(message));
JanetBuffer buf;
janet_buffer_init(&buf, 20);
janet_buffer_push_string(&buf, janet_formatc("bad slot #%d, expected ", n));
janet_buffer_push_types(&buf, expected);
janet_buffer_push_cstring(&buf, ", got ");
janet_buffer_push_cstring(&buf, typestr(args, n));
message = janet_string(buf.data, buf.count);
janet_buffer_deinit(&buf);
JANET_THROWV(args, janet_wrap_string(message));
}
int dst_arity_err(DstArgs args, int32_t n, const char *prefix) {
DST_THROWV(args,
dst_wrap_string(dst_formatc(
int janet_arity_err(JanetArgs args, int32_t n, const char *prefix) {
JANET_THROWV(args,
janet_wrap_string(janet_formatc(
"expected %s%d argument%s, got %d",
prefix, n, n == 1 ? "" : "s", args.n)));
}
int dst_typeabstract_err(DstArgs args, int32_t n, const DstAbstractType *at) {
DST_THROWV(args,
dst_wrap_string(dst_formatc(
int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at) {
JANET_THROWV(args,
janet_wrap_string(janet_formatc(
"bad slot #%d, expected %s, got %s",
n, at->name, typestr(args, n))));
}

46
src/core/util.h
View File

@ -20,37 +20,37 @@
* IN THE SOFTWARE.
*/
#ifndef DST_UTIL_H_defined
#define DST_UTIL_H_defined
#ifndef JANET_UTIL_H_defined
#define JANET_UTIL_H_defined
#include <dst/dst.h>
#include <janet/janet.h>
/* Utils */
extern const char dst_base64[65];
int32_t dst_array_calchash(const Dst *array, int32_t len);
int32_t dst_kv_calchash(const DstKV *kvs, int32_t len);
int32_t dst_string_calchash(const uint8_t *str, int32_t len);
int32_t dst_tablen(int32_t n);
void dst_buffer_push_types(DstBuffer *buffer, int types);
const void *dst_strbinsearch(
extern const char janet_base64[65];
int32_t janet_array_calchash(const Janet *array, int32_t len);
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
int32_t janet_tablen(int32_t n);
void janet_buffer_push_types(JanetBuffer *buffer, int types);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,
size_t itemsize,
const uint8_t *key);
/* Initialize builtin libraries */
int dst_lib_io(DstArgs args);
int dst_lib_math(DstArgs args);
int dst_lib_array(DstArgs args);
int dst_lib_tuple(DstArgs args);
int dst_lib_buffer(DstArgs args);
int dst_lib_table(DstArgs args);
int dst_lib_fiber(DstArgs args);
int dst_lib_os(DstArgs args);
int dst_lib_string(DstArgs args);
int dst_lib_marsh(DstArgs args);
int dst_lib_parse(DstArgs args);
int dst_lib_asm(DstArgs args);
int dst_lib_compile(DstArgs args);
int janet_lib_io(JanetArgs args);
int janet_lib_math(JanetArgs args);
int janet_lib_array(JanetArgs args);
int janet_lib_tuple(JanetArgs args);
int janet_lib_buffer(JanetArgs args);
int janet_lib_table(JanetArgs args);
int janet_lib_fiber(JanetArgs args);
int janet_lib_os(JanetArgs args);
int janet_lib_string(JanetArgs args);
int janet_lib_marsh(JanetArgs args);
int janet_lib_parse(JanetArgs args);
int janet_lib_asm(JanetArgs args);
int janet_lib_compile(JanetArgs args);
#endif

120
src/core/value.c
View File

@ -20,42 +20,42 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
/*
* Define a number of functions that can be used internally on ANY Dst.
* Define a number of functions that can be used internally on ANY Janet.
*/
/* Check if two values are equal. This is strict equality with no conversion. */
int dst_equals(Dst x, Dst y) {
int janet_equals(Janet x, Janet y) {
int result = 0;
if (dst_type(x) != dst_type(y)) {
if (janet_type(x) != janet_type(y)) {
result = 0;
} else {
switch (dst_type(x)) {
case DST_NIL:
case DST_TRUE:
case DST_FALSE:
switch (janet_type(x)) {
case JANET_NIL:
case JANET_TRUE:
case JANET_FALSE:
result = 1;
break;
case DST_REAL:
result = (dst_unwrap_real(x) == dst_unwrap_real(y));
case JANET_REAL:
result = (janet_unwrap_real(x) == janet_unwrap_real(y));
break;
case DST_INTEGER:
result = (dst_unwrap_integer(x) == dst_unwrap_integer(y));
case JANET_INTEGER:
result = (janet_unwrap_integer(x) == janet_unwrap_integer(y));
break;
case DST_STRING:
result = dst_string_equal(dst_unwrap_string(x), dst_unwrap_string(y));
case JANET_STRING:
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
break;
case DST_TUPLE:
result = dst_tuple_equal(dst_unwrap_tuple(x), dst_unwrap_tuple(y));
case JANET_TUPLE:
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
break;
case DST_STRUCT:
result = dst_struct_equal(dst_unwrap_struct(x), dst_unwrap_struct(y));
case JANET_STRUCT:
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
break;
default:
/* compare pointers */
result = (dst_unwrap_pointer(x) == dst_unwrap_pointer(y));
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
break;
}
}
@ -63,43 +63,43 @@ int dst_equals(Dst x, Dst y) {
}
/* Computes a hash value for a function */
int32_t dst_hash(Dst x) {
int32_t janet_hash(Janet x) {
int32_t hash = 0;
switch (dst_type(x)) {
case DST_NIL:
switch (janet_type(x)) {
case JANET_NIL:
hash = 0;
break;
case DST_FALSE:
case JANET_FALSE:
hash = 1;
break;
case DST_TRUE:
case JANET_TRUE:
hash = 2;
break;
case DST_STRING:
case DST_SYMBOL:
hash = dst_string_hash(dst_unwrap_string(x));
case JANET_STRING:
case JANET_SYMBOL:
hash = janet_string_hash(janet_unwrap_string(x));
break;
case DST_TUPLE:
hash = dst_tuple_hash(dst_unwrap_tuple(x));
case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x));
break;
case DST_STRUCT:
hash = dst_struct_hash(dst_unwrap_struct(x));
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
break;
case DST_INTEGER:
hash = dst_unwrap_integer(x);
case JANET_INTEGER:
hash = janet_unwrap_integer(x);
break;
default:
/* TODO - test performance with different hash functions */
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer */
uint64_t i = dst_u64(x);
uint64_t i = janet_u64(x);
hash = (int32_t)(i & 0xFFFFFFFF);
/* Get a bit more entropy by shifting the low bits out */
hash >>= 3;
hash ^= (int32_t) (i >> 32);
} else {
/* Assuming 4 byte pointer (or smaller) */
hash = (int32_t) ((char *)dst_unwrap_pointer(x) - (char *)0);
hash = (int32_t) ((char *)janet_unwrap_pointer(x) - (char *)0);
hash >>= 2;
}
break;
@ -110,47 +110,47 @@ int32_t dst_hash(Dst x) {
/* Compares x to y. If they are equal retuns 0. If x is less, returns -1.
* If y is less, returns 1. All types are comparable
* and should have strict ordering. */
int dst_compare(Dst x, Dst y) {
if (dst_type(x) == dst_type(y)) {
switch (dst_type(x)) {
case DST_NIL:
case DST_FALSE:
case DST_TRUE:
int janet_compare(Janet x, Janet y) {
if (janet_type(x) == janet_type(y)) {
switch (janet_type(x)) {
case JANET_NIL:
case JANET_FALSE:
case JANET_TRUE:
return 0;
case DST_REAL:
case JANET_REAL:
/* Check for nans to ensure total order */
if (dst_unwrap_real(x) != dst_unwrap_real(x))
return dst_unwrap_real(y) != dst_unwrap_real(y)
if (janet_unwrap_real(x) != janet_unwrap_real(x))
return janet_unwrap_real(y) != janet_unwrap_real(y)
? 0
: -1;
if (dst_unwrap_real(y) != dst_unwrap_real(y))
if (janet_unwrap_real(y) != janet_unwrap_real(y))
return 1;
if (dst_unwrap_real(x) == dst_unwrap_real(y)) {
if (janet_unwrap_real(x) == janet_unwrap_real(y)) {
return 0;
} else {
return dst_unwrap_real(x) > dst_unwrap_real(y) ? 1 : -1;
return janet_unwrap_real(x) > janet_unwrap_real(y) ? 1 : -1;
}
case DST_INTEGER:
if (dst_unwrap_integer(x) == dst_unwrap_integer(y)) {
case JANET_INTEGER:
if (janet_unwrap_integer(x) == janet_unwrap_integer(y)) {
return 0;
} else {
return dst_unwrap_integer(x) > dst_unwrap_integer(y) ? 1 : -1;
return janet_unwrap_integer(x) > janet_unwrap_integer(y) ? 1 : -1;
}
case DST_STRING:
case DST_SYMBOL:
return dst_string_compare(dst_unwrap_string(x), dst_unwrap_string(y));
case DST_TUPLE:
return dst_tuple_compare(dst_unwrap_tuple(x), dst_unwrap_tuple(y));
case DST_STRUCT:
return dst_struct_compare(dst_unwrap_struct(x), dst_unwrap_struct(y));
case JANET_STRING:
case JANET_SYMBOL:
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
case JANET_TUPLE:
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
case JANET_STRUCT:
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
default:
if (dst_unwrap_string(x) == dst_unwrap_string(y)) {
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
return 0;
} else {
return dst_unwrap_string(x) > dst_unwrap_string(y) ? 1 : -1;
return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1;
}
}
}
return (dst_type(x) < dst_type(y)) ? -1 : 1;
return (janet_type(x) < janet_type(y)) ? -1 : 1;
}

24
src/core/vector.c
View File

@ -23,52 +23,52 @@
#include "vector.h"
/* Grow the buffer dynamically. Used for push operations. */
void *dst_v_grow(void *v, int32_t increment, int32_t itemsize) {
int32_t dbl_cur = (NULL != v) ? 2 * dst_v__cap(v) : 0;
int32_t min_needed = dst_v_count(v) + increment;
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
int32_t min_needed = janet_v_count(v) + increment;
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
int32_t *p = (int32_t *) realloc(v ? dst_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2);
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2);
if (NULL != p) {
if (!v) p[1] = 0;
p[0] = m;
return p + 2;
} else {
{
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
return (void *) (2 * sizeof(int32_t));
}
}
/* Clone a buffer. */
void *dst_v_copymem(void *v, int32_t itemsize) {
void *janet_v_copymem(void *v, int32_t itemsize) {
int32_t *p;
if (NULL == v) return NULL;
p = malloc(2 * sizeof(int32_t) + itemsize * dst_v__cap(v));
p = malloc(2 * sizeof(int32_t) + itemsize * janet_v__cap(v));
if (NULL != p) {
memcpy(p, dst_v__raw(v), 2 * sizeof(int32_t) + itemsize * dst_v__cnt(v));
memcpy(p, janet_v__raw(v), 2 * sizeof(int32_t) + itemsize * janet_v__cnt(v));
return p + 2;
} else {
{
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
return (void *) (2 * sizeof(int32_t));
}
}
/* Convert a buffer to normal allocated memory (forget capacity) */
void *dst_v_flattenmem(void *v, int32_t itemsize) {
void *janet_v_flattenmem(void *v, int32_t itemsize) {
int32_t *p;
int32_t sizen;
if (NULL == v) return NULL;
sizen = itemsize * dst_v__cnt(v);
sizen = itemsize * janet_v__cnt(v);
p = malloc(sizen);
if (NULL != p) {
memcpy(p, v, sizen);
return p;
} else {
{
DST_OUT_OF_MEMORY;
JANET_OUT_OF_MEMORY;
}
return NULL;
}

42
src/core/vector.h
View File

@ -20,10 +20,10 @@
* IN THE SOFTWARE.
*/
#ifndef DST_VECTOR_H_defined
#define DST_VECTOR_H_defined
#ifndef JANET_VECTOR_H_defined
#define JANET_VECTOR_H_defined
#include <dst/dst.h>
#include <janet/janet.h>
/*
* vector code modified from
@ -34,27 +34,27 @@
* need vector like data structures that are not garbage collected
* and used only from C */
#define dst_v_free(v) (((v) != NULL) ? (free(dst_v__raw(v)), 0) : 0)
#define dst_v_push(v, x) (dst_v__maybegrow(v, 1), (v)[dst_v__cnt(v)++] = (x))
#define dst_v_pop(v) (dst_v_count(v) ? dst_v__cnt(v)-- : 0)
#define dst_v_count(v) (((v) != NULL) ? dst_v__cnt(v) : 0)
#define dst_v_add(v, n) (dst_v__maybegrow(v, n), dst_v_cnt(v) += (n), &(v)[dst_v__cnt(v) - (n)])
#define dst_v_last(v) ((v)[dst_v__cnt(v) - 1])
#define dst_v_empty(v) (((v) != NULL) ? (dst_v__cnt(v) = 0) : 0)
#define dst_v_copy(v) (dst_v_copymem((v), sizeof(*(v))))
#define dst_v_flatten(v) (dst_v_flattenmem((v), sizeof(*(v))))
#define janet_v_free(v) (((v) != NULL) ? (free(janet_v__raw(v)), 0) : 0)
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
#define janet_v_add(v, n) (janet_v__maybegrow(v, n), janet_v_cnt(v) += (n), &(v)[janet_v__cnt(v) - (n)])
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
#define dst_v__raw(v) ((int32_t *)(v) - 2)
#define dst_v__cap(v) dst_v__raw(v)[0]
#define dst_v__cnt(v) dst_v__raw(v)[1]
#define janet_v__raw(v) ((int32_t *)(v) - 2)
#define janet_v__cap(v) janet_v__raw(v)[0]
#define janet_v__cnt(v) janet_v__raw(v)[1]
#define dst_v__needgrow(v, n) ((v) == NULL || dst_v__cnt(v) + (n) >= dst_v__cap(v))
#define dst_v__maybegrow(v, n) (dst_v__needgrow((v), (n)) ? dst_v__grow((v), (n)) : 0)
#define dst_v__grow(v, n) ((v) = dst_v_grow((v), (n), sizeof(*(v))))
#define janet_v__needgrow(v, n) ((v) == NULL || janet_v__cnt(v) + (n) >= janet_v__cap(v))
#define janet_v__maybegrow(v, n) (janet_v__needgrow((v), (n)) ? janet_v__grow((v), (n)) : 0)
#define janet_v__grow(v, n) ((v) = janet_v_grow((v), (n), sizeof(*(v))))
/* Actual functions defined in vector.c */
void *dst_v_grow(void *v, int32_t increment, int32_t itemsize);
void *dst_v_copymem(void *v, int32_t itemsize);
void *dst_v_flattenmem(void *v, int32_t itemsize);
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize);
void *janet_v_copymem(void *v, int32_t itemsize);
void *janet_v_flattenmem(void *v, int32_t itemsize);
#endif

1106
src/core/vm.c
View File

File diff suppressed because it is too large Load Diff

116
src/core/wrap.c
View File

@ -20,141 +20,141 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#ifdef DST_NANBOX
#ifdef JANET_NANBOX
void *dst_nanbox_to_pointer(Dst x) {
void *janet_nanbox_to_pointer(Janet x) {
/* We need to do this shift to keep the higher bits of the pointer
* the same as bit 47 as required by the x86 architecture. We may save
* an instruction if we do x.u64 & DST_NANBOX_POINTERBITS, but this 0s
* an instruction if we do x.u64 & JANET_NANBOX_POINTERBITS, but this 0s
* the high bits, and may make the pointer non-canocial on x86. If we switch
* to 47 bit pointers (which is what userspace uses on Windows, we can use
* the single mask rather than two shifts. */
#if defined (DST_NANBOX_47) || defined (DST_32)
x.i64 &= DST_NANBOX_POINTERBITS;
#if defined (JANET_NANBOX_47) || defined (JANET_32)
x.i64 &= JANET_NANBOX_POINTERBITS;
#else
x.i64 = (x.i64 << 16) >> 16;
#endif
return (void *)x.i64;
}
Dst dst_nanbox_from_pointer(void *p, uint64_t tagmask) {
Dst ret;
Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
Janet ret;
ret.u64 = (int64_t)p;
#if defined (DST_NANBOX_47) || defined (DST_32)
#if defined (JANET_NANBOX_47) || defined (JANET_32)
#else
ret.u64 &= DST_NANBOX_POINTERBITS;
ret.u64 &= JANET_NANBOX_POINTERBITS;
#endif
ret.u64 |= tagmask;
return ret;
}
Dst dst_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
Dst ret;
Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
Janet ret;
ret.u64 = (int64_t)p;
#if defined (DST_NANBOX_47) || defined (DST_32)
#if defined (JANET_NANBOX_47) || defined (JANET_32)
#else
ret.u64 &= DST_NANBOX_POINTERBITS;
ret.u64 &= JANET_NANBOX_POINTERBITS;
#endif
ret.u64 |= tagmask;
return ret;
}
Dst dst_nanbox_from_double(double d) {
Dst ret;
Janet janet_nanbox_from_double(double d) {
Janet ret;
ret.real = d;
/* Normalize NaNs */
if (d != d)
ret.u64 = dst_nanbox_tag(DST_REAL);
ret.u64 = janet_nanbox_tag(JANET_REAL);
return ret;
}
Dst dst_nanbox_from_bits(uint64_t bits) {
Dst ret;
Janet janet_nanbox_from_bits(uint64_t bits) {
Janet ret;
ret.u64 = bits;
return ret;
}
void *dst_nanbox_memalloc_empty(int32_t count) {
void *janet_nanbox_memalloc_empty(int32_t count) {
int32_t i;
void *mem = malloc(count * sizeof(DstKV));
DstKV *mmem = (DstKV *)mem;
void *mem = malloc(count * sizeof(JanetKV));
JanetKV *mmem = (JanetKV *)mem;
for (i = 0; i < count; i++) {
DstKV *kv = mmem + i;
kv->key = dst_wrap_nil();
kv->value = dst_wrap_nil();
JanetKV *kv = mmem + i;
kv->key = janet_wrap_nil();
kv->value = janet_wrap_nil();
}
return mem;
}
void dst_nanbox_memempty(DstKV *mem, int32_t count) {
void janet_nanbox_memempty(JanetKV *mem, int32_t count) {
int32_t i;
for (i = 0; i < count; i++) {
mem[i].key = dst_wrap_nil();
mem[i].value = dst_wrap_nil();
mem[i].key = janet_wrap_nil();
mem[i].value = janet_wrap_nil();
}
}
#else
/* Wrapper functions wrap a data type that is used from C into a
* dst value, which can then be used in dst internal functions. Use
* janet value, which can then be used in janet internal functions. Use
* these functions sparingly, as these function will let the programmer
* leak memory, where as the stack based API ensures that all values can
* be collected by the garbage collector. */
Dst dst_wrap_nil() {
Dst y;
y.type = DST_NIL;
Janet janet_wrap_nil() {
Janet y;
y.type = JANET_NIL;
y.as.u64 = 0;
return y;
}
Dst dst_wrap_true(void) {
Dst y;
y.type = DST_TRUE;
Janet janet_wrap_true(void) {
Janet y;
y.type = JANET_TRUE;
y.as.u64 = 0;
return y;
}
Dst dst_wrap_false(void) {
Dst y;
y.type = DST_FALSE;
Janet janet_wrap_false(void) {
Janet y;
y.type = JANET_FALSE;
y.as.u64 = 0;
return y;
}
Dst dst_wrap_boolean(int x) {
Dst y;
y.type = x ? DST_TRUE : DST_FALSE;
Janet janet_wrap_boolean(int x) {
Janet y;
y.type = x ? JANET_TRUE : JANET_FALSE;
y.as.u64 = 0;
return y;
}
#define DST_WRAP_DEFINE(NAME, TYPE, DTYPE, UM)\
Dst dst_wrap_##NAME(TYPE x) {\
Dst y;\
#define JANET_WRAP_DEFINE(NAME, TYPE, DTYPE, UM)\
Janet janet_wrap_##NAME(TYPE x) {\
Janet y;\
y.type = DTYPE;\
y.as.u64 = 0; /* zero other bits in case of 32 bit integer */ \
y.as.UM = x;\
return y;\
}
DST_WRAP_DEFINE(real, double, DST_REAL, real)
DST_WRAP_DEFINE(integer, int32_t, DST_INTEGER, integer)
DST_WRAP_DEFINE(string, const uint8_t *, DST_STRING, cpointer)
DST_WRAP_DEFINE(symbol, const uint8_t *, DST_SYMBOL, cpointer)
DST_WRAP_DEFINE(array, DstArray *, DST_ARRAY, pointer)
DST_WRAP_DEFINE(tuple, const Dst *, DST_TUPLE, cpointer)
DST_WRAP_DEFINE(struct, const DstKV *, DST_STRUCT, cpointer)
DST_WRAP_DEFINE(fiber, DstFiber *, DST_FIBER, pointer)
DST_WRAP_DEFINE(buffer, DstBuffer *, DST_BUFFER, pointer)
DST_WRAP_DEFINE(function, DstFunction *, DST_FUNCTION, pointer)
DST_WRAP_DEFINE(cfunction, DstCFunction, DST_CFUNCTION, pointer)
DST_WRAP_DEFINE(table, DstTable *, DST_TABLE, pointer)
DST_WRAP_DEFINE(abstract, void *, DST_ABSTRACT, pointer)
JANET_WRAP_DEFINE(real, double, JANET_REAL, real)
JANET_WRAP_DEFINE(integer, int32_t, JANET_INTEGER, integer)
JANET_WRAP_DEFINE(string, const uint8_t *, JANET_STRING, cpointer)
JANET_WRAP_DEFINE(symbol, const uint8_t *, JANET_SYMBOL, cpointer)
JANET_WRAP_DEFINE(array, JanetArray *, JANET_ARRAY, pointer)
JANET_WRAP_DEFINE(tuple, const Janet *, JANET_TUPLE, cpointer)
JANET_WRAP_DEFINE(struct, const JanetKV *, JANET_STRUCT, cpointer)
JANET_WRAP_DEFINE(fiber, JanetFiber *, JANET_FIBER, pointer)
JANET_WRAP_DEFINE(buffer, JanetBuffer *, JANET_BUFFER, pointer)
JANET_WRAP_DEFINE(function, JanetFunction *, JANET_FUNCTION, pointer)
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
#undef DST_WRAP_DEFINE
#undef JANET_WRAP_DEFINE
#endif

1185
src/include/dst/dst.h
View File

File diff suppressed because it is too large Load Diff

1186
src/include/janet/janet.h Normal file
View File

File diff suppressed because it is too large Load Diff

8
src/mainclient/init.dst → src/mainclient/init.janet
View File

@ -17,13 +17,13 @@
-h Show this help
-v Print the version string
-s Use raw stdin instead of getline like functionality
-e Execute a string of dst
-e Execute a string of janet
-r Enter the repl after running all scripts
-p Keep on executing if there is a top level error (persistent)
-- Stop handling options`)
(os.exit 0)
1)
"v" (fn @[] (print dst.version) (os.exit 0) 1)
"v" (fn @[] (print janet.version) (os.exit 0) 1)
"s" (fn @[] (:= *raw-stdin* true) (:= *should-repl* true) 1)
"r" (fn @[] (:= *should-repl* true) 1)
"p" (fn @[] (:= *exit-on-error* false) 1)
@ -53,8 +53,8 @@
(if *raw-stdin*
(repl nil identity)
(do
(print (string "Dst " dst.version " Copyright (C) 2017-2018 Calvin Rose"))
(print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose"))
(repl (fn [buf p]
(def [line] (parser.where p))
(def prompt (string "dst:" line ":" (parser.state p) "> "))
(def prompt (string "janet:" line ":" (parser.state p) "> "))
(getline prompt buf)))))))

68
src/mainclient/line.c
View File

@ -23,17 +23,17 @@
#include "line.h"
/* Common */
int dst_line_getter(DstArgs args) {
DST_FIXARITY(args, 2);
DST_CHECK(args, 0, DST_STRING);
DST_CHECK(args, 1, DST_BUFFER);
dst_line_get(
dst_unwrap_string(args.v[0]),
dst_unwrap_buffer(args.v[1]));
DST_RETURN(args, args.v[0]);
int janet_line_getter(JanetArgs args) {
JANET_FIXARITY(args, 2);
JANET_CHECK(args, 0, JANET_STRING);
JANET_CHECK(args, 1, JANET_BUFFER);
janet_line_get(
janet_unwrap_string(args.v[0]),
janet_unwrap_buffer(args.v[1]));
JANET_RETURN(args, args.v[0]);
}
static void simpleline(DstBuffer *buffer) {
static void simpleline(JanetBuffer *buffer) {
buffer->count = 0;
char c;
for (;;) {
@ -41,23 +41,23 @@ static void simpleline(DstBuffer *buffer) {
if (feof(stdin) || c < 0) {
break;
}
dst_buffer_push_u8(buffer, (uint8_t) c);
janet_buffer_push_u8(buffer, (uint8_t) c);
if (c == '\n') break;
}
}
/* Windows */
#ifdef DST_WINDOWS
#ifdef JANET_WINDOWS
void dst_line_init() {
void janet_line_init() {
;
}
void dst_line_deinit() {
void janet_line_deinit() {
;
}
void dst_line_get(const uint8_t *p, DstBuffer *buffer) {
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
fputs((const char *)p, stdout);
simpleline(buffer);
}
@ -84,16 +84,16 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#include <signal.h>
/* static state */
#define DST_LINE_MAX 1024
#define DST_HISTORY_MAX 100
#define JANET_LINE_MAX 1024
#define JANET_HISTORY_MAX 100
static int israwmode = 0;
static const char *prompt = "> ";
static int plen = 2;
static char buf[DST_LINE_MAX];
static char buf[JANET_LINE_MAX];
static int len = 0;
static int pos = 0;
static int cols = 80;
static char *history[DST_HISTORY_MAX];
static char *history[JANET_HISTORY_MAX];
static int history_count = 0;
static int historyi = 0;
static struct termios termios_start;
@ -185,7 +185,7 @@ static void clear() {
static void refresh() {
char seq[64];
DstBuffer b;
JanetBuffer b;
/* Keep cursor position on screen */
char *_buf = buf;
@ -200,22 +200,22 @@ static void refresh() {
_len--;
}
dst_buffer_init(&b, 0);
janet_buffer_init(&b, 0);
/* Cursor to left edge, prompt and buffer */
dst_buffer_push_u8(&b, '\r');
dst_buffer_push_cstring(&b, prompt);
dst_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
/* Erase to right */
dst_buffer_push_cstring(&b, "\x1b[0K");
janet_buffer_push_cstring(&b, "\x1b[0K");
/* Move cursor to original position. */
snprintf(seq, 64,"\r\x1b[%dC", (int)(_pos + plen));
dst_buffer_push_cstring(&b, seq);
janet_buffer_push_cstring(&b, seq);
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
dst_buffer_deinit(&b);
janet_buffer_deinit(&b);
}
static int insert(char c) {
if (len < DST_LINE_MAX - 1) {
if (len < JANET_LINE_MAX - 1) {
if (len == pos) {
buf[pos++] = c;
buf[++len] = '\0';
@ -249,7 +249,7 @@ static void historymove(int delta) {
historyi = history_count - 1;
return;
}
strncpy(buf, history[historyi], DST_LINE_MAX);
strncpy(buf, history[historyi], JANET_LINE_MAX);
pos = len = strlen(buf);
buf[len] = '\0';
@ -262,11 +262,11 @@ static void addhistory() {
char *newline = sdup(buf);
if (!newline) return;
len = history_count;
if (len < DST_HISTORY_MAX) {
if (len < JANET_HISTORY_MAX) {
history[history_count++] = newline;
len++;
} else {
free(history[DST_HISTORY_MAX - 1]);
free(history[JANET_HISTORY_MAX - 1]);
}
for (i = len - 1; i > 0; i--) {
history[i] = history[i - 1];
@ -425,11 +425,11 @@ static int line() {
return 0;
}
void dst_line_init() {
void janet_line_init() {
;
}
void dst_line_deinit() {
void janet_line_deinit() {
int i;
norawmode();
for (i = 0; i < history_count; i++)
@ -446,7 +446,7 @@ static int checktermsupport() {
return 1;
}
void dst_line_get(const uint8_t *p, DstBuffer *buffer) {
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
prompt = (const char *)p;
buffer->count = 0;
historyi = 0;
@ -465,7 +465,7 @@ void dst_line_get(const uint8_t *p, DstBuffer *buffer) {
}
norawmode();
fputc('\n', stdout);
dst_buffer_ensure(buffer, len + 1);
janet_buffer_ensure(buffer, len + 1);
memcpy(buffer->data, buf, len);
buffer->data[len] = '\n';
buffer->count = len + 1;

14
src/mainclient/line.h
View File

@ -20,15 +20,15 @@
* IN THE SOFTWARE.
*/
#ifndef DST_LINE_H_defined
#define DST_LINE_H_defined
#ifndef JANET_LINE_H_defined
#define JANET_LINE_H_defined
#include <dst/dst.h>
#include <janet/janet.h>
void dst_line_init();
void dst_line_deinit();
void janet_line_init();
void janet_line_deinit();
void dst_line_get(const uint8_t *p, DstBuffer *buffer);
int dst_line_getter(DstArgs args);
void janet_line_get(const uint8_t *p, JanetBuffer *buffer);
int janet_line_getter(JanetArgs args);
#endif

28
src/mainclient/main.c
View File

@ -20,37 +20,37 @@
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <janet/janet.h>
#include <generated/init.h>
#include "line.h"
int main(int argc, char **argv) {
int i, status;
DstArray *args;
DstTable *env;
JanetArray *args;
JanetTable *env;
/* Set up VM */
dst_init();
env = dst_core_env();
janet_init();
env = janet_core_env();
/* Create args tuple */
args = dst_array(argc);
args = janet_array(argc);
for (i = 0; i < argc; i++)
dst_array_push(args, dst_cstringv(argv[i]));
dst_def(env, "process.args", dst_wrap_array(args));
janet_array_push(args, janet_cstringv(argv[i]));
janet_def(env, "process.args", janet_wrap_array(args));
/* Expose line getter */
dst_def(env, "getline", dst_wrap_cfunction(dst_line_getter));
dst_register("getline", dst_wrap_cfunction(dst_line_getter));
dst_line_init();
janet_def(env, "getline", janet_wrap_cfunction(janet_line_getter));
janet_register("getline", janet_wrap_cfunction(janet_line_getter));
janet_line_init();
/* Run startup script */
status = dst_dobytes(env, dst_gen_init, sizeof(dst_gen_init), "init.dst");
status = janet_dobytes(env, janet_gen_init, sizeof(janet_gen_init), "init.janet");
/* Deinitialize vm */
dst_deinit();
dst_line_deinit();
janet_deinit();
janet_line_deinit();
return status;
}

0
test/helper.dst → test/helper.janet
View File

0
test/suite0.dst → test/suite0.janet
View File

0
test/suite1.dst → test/suite1.janet
View File

0
test/suite2.dst → test/suite2.janet
View File