anoma/juvix
1
1
Fork 0
mirror of https://github.com/anoma/juvix.git synced 2024-12-22 22:31:33 +03:00
Code Issues Projects Releases Wiki Activity

Juvix C runtime (#1580)

Browse Source
This commit is contained in:
Łukasz Czajka 2022-11-03 09:38:09 +01:00 committed by GitHub
parent 23c2b9e713
commit 74bfe592f5
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
184 changed files with 10022 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.clang-format Normal file
View File

@ -0,0 +1 @@
{ BasedOnStyle: Google, IndentWidth: 4 }

30
.github/workflows/ci.yml vendored
View File

@ -38,6 +38,15 @@ jobs:
--ghc-opt -XTemplateHaskell
--ghc-opt -XUnicodeSyntax
clang-format:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- uses: jidicula/clang-format-action@v4.9.0
with:
clang-format-version: '15'
check-path: 'runtime/src'
hlint:
runs-on: ubuntu-latest
steps:
@ -86,7 +95,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-latest , macOS-latest]
os: [ubuntu-latest]
ghc: ["9.2.4"]
steps:
- name: Checkout our repository
@ -118,7 +127,22 @@ jobs:
enable-stack: true
stack-version: 'latest'
- name: Build Haskell Project
- name: Cache LLVM and Clang
id: cache-llvm
uses: actions/cache@v3
with:
path: |
C:/Program Files/LLVM
./llvm
key: ${{ runner.os }}-llvm-13
- name: Install LLVM and Clang
uses: KyleMayes/install-llvm-action@v1
with:
version: "13.0"
cached: ${{ steps.cache-llvm.outputs.cache-hit }}
- name: Build Project
run: |
cd main
make build
@ -128,7 +152,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-latest , macOS-latest]
os: [ubuntu-latest]
ghc: ["9.2.4"]
steps:
- name: Checkout the main repository

9
.gitignore vendored
View File

@ -56,7 +56,9 @@ TAGS
# other
.DS_Store
/runtime/include
_build/
_build.*/
*.agdai
.agda/
agda2hs/
@ -68,10 +70,17 @@ UPDATES-FOR-CHANGELOG.org
.juvix-build
# C Code generation
*.out.c
*.s
*.wasm
*.exe
docs/md/
_docs
docs/**/*.md
**/html/*
*.cmi
*.cmx
*.cmo
docs/org/README.org

41
Makefile
View File

@ -36,12 +36,16 @@ endif
all: install
clean:
clean: clean-runtime
@stack clean --full
@rm -rf .hie
@rm -rf _docs
@rm -rf docs/md
.PHONY: clean-runtime
clean-runtime:
@cd runtime && make clean
repl:
@stack ghci Juvix:lib
@ -111,7 +115,8 @@ ORMOLUFILES = $(shell git ls-files '*.hs' '*.hs-boot' | grep -v '^contrib/')
ORMOLUFLAGS?=--no-cabal
ORMOLUMODE?=inplace
format:
.PHONY: format
format: clang-format
@stack exec -- ormolu ${ORMOLUFLAGS} \
--ghc-opt -XStandaloneDeriving \
--ghc-opt -XUnicodeSyntax \
@ -122,6 +127,10 @@ format:
--mode ${ORMOLUMODE} \
$(ORMOLUFILES)
.PHONY: clang-format
clang-format:
@cd runtime && make format
.PHONY: check-ormolu
check-ormolu: export ORMOLUMODE = check
check-ormolu:
@ -145,7 +154,7 @@ pre-commit :
# -- Build-Install-Test-Release
# ------------------------------------------------------------------------------
STACKFLAGS?=--fast --jobs $(THREADS)
STACKFLAGS?=--jobs $(THREADS)
.PHONY: check
check:
@ -163,26 +172,46 @@ submodules:
@git submodule sync
@git submodule update --init --recursive
.PHONY : build
build: submodules
.PHONY: build
build: submodules runtime
stack build ${STACKFLAGS}
.PHONY: fast-build
fast-build: submodules runtime
stack build --fast ${STACKFLAGS}
.PHONY: runtime
runtime:
cd runtime && make -j 4
# -- Install
.PHONY : install
install: submodules
install: runtime submodules
@stack install ${STACKFLAGS}
.PHONY : fast-install
fast-install: runtime submodules
@stack install --fast ${STACKFLAGS}
# -- Testing
.PHONY : test
test: build
@stack test ${STACKFLAGS}
.PHONY : fast-test
fast-test: fast-build
@stack test --fast ${STACKFLAGS}
.PHONY : test-skip-slow
test-skip-slow:
@stack test ${STACKFLAGS} --ta '-p "! /slow tests/"'
.PHONY : fast-test-skip-slow
fast-test-skip-slow:
@stack test --fast ${STACKFLAGS} --ta '-p "! /slow tests/"'
SHELLTEST := $(shell command -v shelltest 2> /dev/null)
.PHONY : test-shell

2
app/Commands/Dev.hs
View File

@ -14,6 +14,7 @@ import Commands.Dev.Internal qualified as Internal
import Commands.Dev.MiniC qualified as MiniC
import Commands.Dev.Options
import Commands.Dev.Parse qualified as Parse
import Commands.Dev.Runtime qualified as Runtime
import Commands.Dev.Scope qualified as Scope
import Commands.Dev.Termination qualified as Termination
@ -28,4 +29,5 @@ runCommand = \case
Termination opts -> Termination.runCommand opts
Core opts -> Core.runCommand opts
Asm opts -> Asm.runCommand opts
Runtime opts -> Runtime.runCommand opts
DisplayRoot -> DisplayRoot.runCommand

10
app/Commands/Dev/Options.hs
View File

@ -18,6 +18,7 @@ import Commands.Dev.Highlight.Options
import Commands.Dev.Internal.Options
import Commands.Dev.MiniC.Options
import Commands.Dev.Parse.Options
import Commands.Dev.Runtime.Options
import Commands.Dev.Scope.Options
import Commands.Dev.Termination.Options
import CommonOptions
@ -28,6 +29,7 @@ data DevCommand
| Internal InternalCommand
| Core CoreCommand
| Asm AsmCommand
| Runtime RuntimeCommand
| MiniC MiniCOptions
| Parse ParseOptions
| Scope ScopeOptions
@ -43,6 +45,7 @@ parseDevCommand =
commandInternal,
commandCore,
commandAsm,
commandRuntime,
commandMiniC,
commandParse,
commandDoc,
@ -94,6 +97,13 @@ commandAsm =
(Asm <$> parseAsmCommand)
(progDesc "Subcommands related to JuvixAsm")
commandRuntime :: Mod CommandFields DevCommand
commandRuntime =
command "runtime" $
info
(Runtime <$> parseRuntimeCommand)
(progDesc "Subcommands related to the Juvix runtime")
commandParse :: Mod CommandFields DevCommand
commandParse =
command "parse" $

9
app/Commands/Dev/Runtime.hs Normal file
View File

@ -0,0 +1,9 @@
module Commands.Dev.Runtime where
import Commands.Base
import Commands.Dev.Runtime.Compile as Compile
import Commands.Dev.Runtime.Options
runCommand :: forall r. Members '[Embed IO, App] r => RuntimeCommand -> Sem r ()
runCommand = \case
Compile opts -> Compile.runCommand opts

175
app/Commands/Dev/Runtime/Compile.hs Normal file
View File

@ -0,0 +1,175 @@
module Commands.Dev.Runtime.Compile where
import Commands.Base
import Commands.Dev.Runtime.Compile.Options
import Data.ByteString qualified as BS
import Data.FileEmbed qualified as FE
import Juvix.Extra.Paths
import System.Environment
import System.Process qualified as P
runCommand :: forall r. Members '[Embed IO, App] r => RuntimeCompileOptions -> Sem r ()
runCommand opts = do
root <- askRoot
let inputFile = opts ^. runtimeCompileInputFile . pathPath
result <- embed (runCompile root inputFile opts)
case result of
Left err -> printFailureExit err
_ -> return ()
juvixIncludeDir :: FilePath
juvixIncludeDir = juvixBuildDir </> "include"
runCompile :: FilePath -> FilePath -> RuntimeCompileOptions -> IO (Either Text ())
runCompile projRoot inputFile o = do
createDirectoryIfMissing True (projRoot </> juvixBuildDir)
createDirectoryIfMissing True (projRoot </> juvixIncludeDir)
prepareRuntime projRoot o
case o ^. runtimeCompileTarget of
TargetWasm32Wasi -> runM (runError (clangWasmWasiCompile inputFile o))
TargetNative64 -> runM (runError (clangNativeCompile inputFile o))
prepareRuntime :: FilePath -> RuntimeCompileOptions -> IO ()
prepareRuntime projRoot o = do
mapM_ writeHeader headersDir
case o ^. runtimeCompileTarget of
TargetWasm32Wasi | o ^. runtimeCompileDebug -> writeRuntime wasiDebugRuntime
TargetWasm32Wasi -> writeRuntime wasiReleaseRuntime
TargetNative64 | o ^. runtimeCompileDebug -> writeRuntime nativeDebugRuntime
TargetNative64 -> writeRuntime nativeReleaseRuntime
where
wasiReleaseRuntime :: BS.ByteString
wasiReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi/libjuvix.a" >>= FE.embedFile)
nativeReleaseRuntime :: BS.ByteString
nativeReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.native64/libjuvix.a" >>= FE.embedFile)
wasiDebugRuntime :: BS.ByteString
wasiDebugRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi-debug/libjuvix.a" >>= FE.embedFile)
nativeDebugRuntime :: BS.ByteString
nativeDebugRuntime = $(FE.makeRelativeToProject "runtime/_build.native64-debug/libjuvix.a" >>= FE.embedFile)
headersDir :: [(FilePath, BS.ByteString)]
headersDir = $(FE.makeRelativeToProject "runtime/include" >>= FE.embedDir)
writeRuntime :: BS.ByteString -> IO ()
writeRuntime =
BS.writeFile (projRoot </> juvixBuildDir </> "libjuvix.a")
writeHeader :: (FilePath, BS.ByteString) -> IO ()
writeHeader (filePath, contents) = do
createDirectoryIfMissing True (projRoot </> juvixIncludeDir </> takeDirectory filePath)
BS.writeFile (projRoot </> juvixIncludeDir </> filePath) contents
clangNativeCompile ::
forall r.
Members '[Embed IO, Error Text] r =>
FilePath ->
RuntimeCompileOptions ->
Sem r ()
clangNativeCompile inputFile o =
runClang (native64Args o outputFile inputFile)
where
outputFile :: FilePath
outputFile = maybe defaultOutputFile (^. pathPath) (o ^. runtimeCompileOutputFile)
defaultOutputFile :: FilePath
defaultOutputFile
| o ^. runtimeCompilePreprocess = takeBaseName inputFile <> ".out.c"
| o ^. runtimeCompileAssembly = takeBaseName inputFile <> ".s"
| otherwise = takeBaseName inputFile
clangWasmWasiCompile ::
forall r.
Members '[Embed IO, Error Text] r =>
FilePath ->
RuntimeCompileOptions ->
Sem r ()
clangWasmWasiCompile inputFile o = clangArgs >>= runClang
where
clangArgs :: Sem r [String]
clangArgs = wasiArgs o outputFile inputFile <$> sysrootEnvVar
outputFile :: FilePath
outputFile = maybe defaultOutputFile (^. pathPath) (o ^. runtimeCompileOutputFile)
defaultOutputFile :: FilePath
defaultOutputFile
| o ^. runtimeCompilePreprocess = takeBaseName inputFile <> ".out.c"
| o ^. runtimeCompileAssembly = takeBaseName inputFile <> ".wat"
| otherwise = takeBaseName inputFile <> ".wasm"
sysrootEnvVar :: Sem r String
sysrootEnvVar =
fromMaybeM (throw msg) (embed (lookupEnv "WASI_SYSROOT_PATH"))
where
msg :: Text
msg = "Missing environment variable WASI_SYSROOT_PATH"
commonArgs :: RuntimeCompileOptions -> FilePath -> [String]
commonArgs o outputFile =
["-E" | o ^. runtimeCompilePreprocess]
<> ["-S" | o ^. runtimeCompileAssembly]
<> (if o ^. runtimeCompileDebug then ["-DDEBUG"] else ["-DNDEBUG"])
<> [ "-W",
"-Wall",
"-Wno-unused-parameter",
"-Wno-unused-label",
"-Werror",
"-std=c11",
"-I",
juvixIncludeDir,
"-o",
outputFile
]
<> ( if
| not (o ^. runtimeCompilePreprocess || o ^. runtimeCompileAssembly) ->
[ "-L",
juvixBuildDir
]
| otherwise -> []
)
native64Args :: RuntimeCompileOptions -> FilePath -> FilePath -> [String]
native64Args o outputFile inputFile =
commonArgs o outputFile
<> [ "-DARCH_NATIVE64",
"-DAPI_LIBC",
"-m64",
"-O3",
inputFile
]
<> ( if
| not (o ^. runtimeCompilePreprocess || o ^. runtimeCompileAssembly) ->
["-ljuvix"]
| otherwise -> []
)
wasiArgs :: RuntimeCompileOptions -> FilePath -> FilePath -> FilePath -> [String]
wasiArgs o outputFile inputFile sysrootPath =
commonArgs o outputFile
<> [ "-DARCH_WASM32",
"-DAPI_WASI",
"-Os",
"-nodefaultlibs",
"--target=wasm32-wasi",
"--sysroot",
sysrootPath,
inputFile
]
<> ( if
| not (o ^. runtimeCompilePreprocess || o ^. runtimeCompileAssembly) ->
["-ljuvix"]
| otherwise -> []
)
runClang ::
Members '[Embed IO, Error Text] r =>
[String] ->
Sem r ()
runClang args = do
(exitCode, _, err) <- embed (P.readProcessWithExitCode "clang" args "")
case exitCode of
ExitSuccess -> return ()
_ -> throw (pack err)

63
app/Commands/Dev/Runtime/Compile/Options.hs Normal file
View File

@ -0,0 +1,63 @@
module Commands.Dev.Runtime.Compile.Options where
import CommonOptions
data RuntimeCompileTarget = TargetWasm32Wasi | TargetNative64
deriving stock (Show, Data)
data RuntimeCompileOptions = RuntimeCompileOptions
{ _runtimeCompileDebug :: Bool,
_runtimeCompilePreprocess :: Bool,
_runtimeCompileAssembly :: Bool,
_runtimeCompileOutputFile :: Maybe Path,
_runtimeCompileTarget :: RuntimeCompileTarget,
_runtimeCompileInputFile :: Path
}
deriving stock (Data)
makeLenses ''RuntimeCompileOptions
parseRuntimeCompileOptions :: Parser RuntimeCompileOptions
parseRuntimeCompileOptions = do
_runtimeCompileDebug <-
switch
( short 'g'
<> long "debug"
<> help "Generate debug information and runtime assertions"
)
_runtimeCompilePreprocess <-
switch
( short 'E'
<> long "preprocess"
<> help "Run the C preprocessor only"
)
_runtimeCompileAssembly <-
switch
( short 'S'
<> long "assemble"
<> help "Produce assembly output"
)
_runtimeCompileTarget <-
option
(eitherReader parseTarget)
( long "target"
<> short 't'
<> metavar "TARGET"
<> value TargetNative64
<> showDefaultWith targetShow
<> help "select a target: wasm32-wasi, native"
)
_runtimeCompileOutputFile <- optional parseGenericOutputFile
_runtimeCompileInputFile <- parseInputCFile
pure RuntimeCompileOptions {..}
where
parseTarget :: String -> Either String RuntimeCompileTarget
parseTarget = \case
"wasm32-wasi" -> Right TargetWasm32Wasi
"native" -> Right TargetNative64
s -> Left $ "unrecognised target: " <> s
targetShow :: RuntimeCompileTarget -> String
targetShow = \case
TargetWasm32Wasi -> "wasm32-wasi"
TargetNative64 -> "native"

24
app/Commands/Dev/Runtime/Options.hs Normal file
View File

@ -0,0 +1,24 @@
module Commands.Dev.Runtime.Options where
import Commands.Dev.Runtime.Compile.Options
import CommonOptions
newtype RuntimeCommand
= Compile RuntimeCompileOptions
deriving stock (Data)
parseRuntimeCommand :: Parser RuntimeCommand
parseRuntimeCommand =
hsubparser $
mconcat
[ commandCompile
]
where
commandCompile :: Mod CommandFields RuntimeCommand
commandCompile = command "compile" compileInfo
compileInfo :: ParserInfo RuntimeCommand
compileInfo =
info
(Compile <$> parseRuntimeCompileOptions)
(progDesc "Compile a C file with Juvix runtime included")

14
app/CommonOptions.hs
View File

@ -57,6 +57,17 @@ parseInputJuvixAsmFile = do
)
pure Path {_pathIsInput = True, ..}
parseInputCFile :: Parser Path
parseInputCFile = do
_pathPath <-
argument
str
( metavar "C_FILE"
<> help "Path to a .c file"
<> completer juvixCCompleter
)
pure Path {_pathIsInput = True, ..}
parseGenericOutputFile :: Parser Path
parseGenericOutputFile = do
_pathPath <-
@ -98,6 +109,9 @@ juvixCoreCompleter = extCompleter "jvc"
juvixAsmCompleter :: Completer
juvixAsmCompleter = extCompleter "jva"
juvixCCompleter :: Completer
juvixCCompleter = extCompleter "c"
requote :: String -> String
requote s =
let -- Bash doesn't appear to allow "mixed" escaping

326
docs/org/notes/runtime-benchmark-results.org Normal file
View File

@ -0,0 +1,326 @@
Benchmarks of the new Juvix runtime
====================================
Benchmarked version: commit 148ececb4d4259eacbb980f5992073a3ac611d82 from 31.10.2022
Summary
-------
We benchmark several programs manually compiled into the primitives of
the new Juvix runtime. The code corresponds closely to the code that
will be generated by the new compilation process, with basic low-level
optimisations (unboxing, untagging, etc.) but without any high-level
optimisations on JuvixCore (inlining, specialisation, constant
folding, fusion, etc.). This corresponds to the compilation process
planned for the 0.4 milestone.
We compare the running time and memory usage with analogous programs
written in Haskell, OCaml, JuvixCore (using the evaluator), current
Juvix (with the "direct" transpilation to C) and C.
The results suggest that for most first-order programs the new
compilation process will produce code with running time comparable to
the code produced by the native OCaml compiler. For higher-order
programs heavy on closure manipulation, the results are acceptable but
noticeably worse, especially with third-order functions
(i.e. functions which take functions taking functions). This could,
however, be alleviated by implementing the specialisation optimisation
(see the "specialised" column in the `ackermann` and `mapfun`
benchmarks). Besides, functional programs of order higher than two are
rare.
The comparisons with OCaml and Haskell were not entirely fair because
the new Juvix runtime does not perform garbage collection. The
overhead of garbage collection is particularly visible on the
`mergesort` benchmark which creates many intermediate data structures
that are quickly discarded. With proper memory management, the running
time results on first-order programs for the new Juvix runtime are
expected to become slightly worse than for the native OCaml compiler.
For simple programs operating on integers which don't require any heap
memory allocation (`fibonacci` and `combinations` benchmarks), the
direct transpilation to C in the current Juvix seems to perform best
(behind only C). The reason is that for very simple programs `clang`
can better optimise the output of such a direct transpiler. The main
problem with the transpilation to C approach is that it cannot scale
to reliably work for more complex programs, as evidenced by the
segfaults, longer running time and higher memory use on other
benchmarks.
In addition to the `fibonacci` and `combinations` benchmarks, the
advantage of direct transpilation for very simple programs is also
visible on the `fold` benchmark where a simple loop over a list
dominates the running time. However, this is partly because the
compilation of closures in current Juvix is incorrect allowing it
to be more efficient.
Benchmark programs
------------------
* fibonacci: compute the Nth Fibonacci number modulo 2^28 (N = 100’000’000)
The Nth Fibonacci number is computed in O(N). Needs only constant
stack space and no heap memory. This benchmark tests the
efficiency of tail recursion and arithmetic operations.
* combinations: count combinations of numbers 1 to N having sum N (N = 100)
This benchmark tests the efficiency of general recursion. No heap
memory needs to be allocated. Uses stack space proportional to
N. The running time is exponential in N.
* prime: compute the Nth prime (N = 16384)
The Nth prime number is computed via the Eratosthenes sieve. A
list of N primes is created. No intermediate lists are discarded
(garbage collection not needed). This benchmark tests the
efficiency of tail recursion, arithmetic operations, list cell
allocation and access.
* mergesort: merge sort a list of N integers (N = 2’000’000)
At each level of merge sort intermediate lists are created and
discarded. The running time for this benchmark largely depends on
the efficiency of memory management. Here one may observe the
overhead of garbage collection or the memory blow-up if no garbage
collection is used.
* maybe: optionally sum N integers from a binary tree K times (N = 2^20, K = 100)
If a fixed number k is encountered in the tree then the result is
`Nothing`, otherwise it is `Just sum`. The computation is repeated
for values of k from 0 to K. This tests the efficiency of handling
optional values and data structure access.
* fold: fold a list of N integers K times (N = 100’000, K = 1000)
The sum of N natural numbers is computed via fold_left
(tail-recursive). The computation is repeated K times. The list is
created only once, so that allocation time does not dominate. This
benchmark tests the efficiency of closure call and list cell
access.
* cps: compute the Nth Fibonacci number modulo 2^28 with CPS (N = 100’000’000)
The function computing the Nth Fibonacci number is written in
continuation-passing style, tail-recursively calling a
continuation supplied as an argument. This benchmark tests the
efficiency of closure call and allocation.
* mapfold: map and fold a list of N integers K times (N = 10000, K = 10000)
This benchmark tests the efficiency of standard higher-order
functions on lists, closure call and memory management. The
program allocates O(K) intermediate lists of length N which are
quickly discarded.
* ackermann: compute Ack(3, N) with the higher-order Ackermann function definition (N = 11)
The higher-order Ackermann function definition iterates an
iteration of function compositions. Hence, it uses a third-order
invocation of an iteration function. This benchmark tests the
efficiency of creating and calling second-order closures, and of
partial application.
* mapfun: successively map K functions to a list of N integers (K = 100, N = 10000)
The benchmark stores K second-order closures in a list, maps them
successively to a list of K closures, and then successively maps
the K closures from the result to a list of N integers. This
benchmark tests the efficiency of manipulating closures and
storing them in data structures.
The benchmark programs can be found in `tests/benchmark` in the Juvix
source directory.
Methodology
-----------
For each program the total running time (elapsed real time) and memory
use (maximum resident set size) were measured on an M1 iMac with no
significant background activity. Averages of several runs were taken.
The variance was negligible, unless indicated otherwise by providing a
range.
Results
-------
* fibonacci: compute the Nth Fibonacci number modulo 2^28 (N = 100’000’000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |0.26 |0.35 |0.35 |0.23 |13.15 |10.03 |0.39 |0.35 |0.94 |0.16 |0.22 |
|Memory use (MB, max RSS)|1.5 |3.8 |1.3 |8.8 |21.3 |8067.7 |9.7 |1.7 |1.8 |1.3 |4.0 |
* combinations: count all combinations of numbers 1 to N having sum N (N = 1000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |6.67 |11.25 |3.22 |5.1 |441.71 |5.48 |5.48 |6.53 |41.08 |2.69 |4.80 |
|Memory use (MB, max RSS)|1.5 |3.9 |1.3 |8.9 |22.3 |9.6 |9.6 |1.7 |1.9 |1.3 |4.0 |
* prime: compute the Nth prime (N = 16384)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |1.52 |1.91 |segfault |3.09 |167.04 |3.85 |3.85 |1.68 |14.82 |0.12 |0.13 |
|Memory use (MB, max RSS)|1.7 |4.0 |segfault |9.3 |24.4 |9.8 |9.6 |2.2 |2.2 |1.4 |4.0 |
* mergesort: merge sort a list of N integers (N = 2’000’000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |0.40 |0.31 |3.55 |1.32 |22.45 |2.86 |2.90 |1.95 |3.52 |0.15 |0.15 |
|Memory use (MB, max RSS)|1973.7 |720.4 |5046.7 |2729.8 |1728.9 |253.6 |253.6 |172.6 |343.1 |24.4 |26.8 |
* maybe: optionally sum N non-zero integers from a binary tree K times (N = 2^20, K = 100)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |0.45 |0.64 |3.29 |1.57 |22.75 |5.58 |0.59 |0.30 |3.57 |0.27 |0.50 |
|Memory use (MB, max RSS)|1.6 |3.8 |2646.1 |1320.9 |22.4 |5560.7 |9.7 |3.9 |4.0 |1.3 |4.1 |
* fold: fold a list of N integers K times (N = 100’000, K = 1000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |0.45 |0.54 |0.35 |0.23 |15.27 |0.58 |0.58 |0.36 |1.80 |NA |NA |
|Memory use (MB, max RSS)|3.1 |4.6 |4.4 |10.6 |43.4 |12.7 |12.7 |5.9 |5.9 |NA |NA |
* cps: compute the Nth Fibonacci number modulo 2^28 with CPS (N = 100’000’000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |0.43 |0.52 |1.56 |stack overflow |20.22 |10.04 |0.39 |0.35 |1.60 |0.16 |0.25 |
|Memory use (MB, max RSS)|1.5 |3.9 |1539.3 |stack overflow |21.3 |8067.7 |9.7 |1.7 |1.8 |1.3 |4.0 |
* mapfold: map and fold a list of N integers K times (N = 10000, K = 10000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |1.01 |1.59 |2.74 |1.81 |38.24 |1.29 |2.42 |1.43 |4.22 |NA |NA |
|Memory use (MB, max RSS)|2154.5 |893.0 |3059.1 |1542.0 |26.4 |10.6 |10.7 |7.5 |10-20 |NA |NA |
* ackermann: compute Ack(3, N) with the higher-order Ackermann function definition (N = 11)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|New Juvix runtime (specialised, native)|New Juvix runtime (specialised, wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|---------------------------------------|-----------------------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |0.92 |1.21 |0.30 |0.65 |segfault |runtime error |11.71 |0.87 |0.47 |0.54 |1.35 |0.00 |0.14 |
|Memory use (MB, max RSS)|2.6 |4.1 |2.3 |3.9 |segfault |runtime error |23.3 |13.6 |9.6 |2.0 |3.6 |1.3 |4.0 |
* mapfun: successively map K functions to a list of N integers (K = 100, N = 10000)
| |New Juvix runtime (native)|New Juvix runtime (wasm32, wasmer)|New Juvix runtime (specialised, native)|New Juvix runtime (specialised, wasm32, wasmer)|Current Juvix (native)|Current Juvix (wasm32, wasmer)|JuvixCore evaluator|Haskell (native, ghc -O2)|Haskell (native, ghc -XStrict -O2)|OCaml (native, ocamlopt -O2)|OCaml (bytecode)|C (native, clang -O3)|C (wasm32, clang -Os, wasmer)|
|------------------------|--------------------------|----------------------------------|---------------------------------------|-----------------------------------------------|----------------------|------------------------------|-------------------|-------------------------|----------------------------------|----------------------------|----------------|---------------------|-----------------------------|
|Time (seconds, real) |1.27 |1.04 |0.39 |0.46 |segfault |runtime error |4.18 |1.85 |0.95 |0.19 |0.68 |NA |NA |
|Memory use (MB, max RSS)|3209.8 |1229.7 |21.8 |13.2 |segfault |runtime error |33.0 |13.6 |11.6 |5.3 |7.9 |NA |NA |
Comments
--------
* "New Juvix runtime" denotes C programs written using the primitives
of the new Juvix runtime. These programs were "manually" compiled
from the corresponding Juvix/JuvixCore programs, according to the
new Juvix compilation concept. They correspond closely to the code
that will be generated by the basic version of the new compilation
process, without any high-level optimisations (inlining,
specialisation, fusion, constant folding) but with basic low-level
memory representation optimisations (unboxing, untagging, etc). This
version of the new compilation process should be finished with the
0.4 milestone.
* The "specialised" column for "New Juvix runtime" denotes a version
of the corresponding "New Juvix runtime" benchmark program for which
specialisation of higher-order functions was manually performed (to
simulate the effects of the high-level specialisation optimisation).
* "Current Juvix" denotes Juvix programs compiled with the current
compilation process via a "direct" translation to C. For a fair
comparison, all number operations were implemented using native
binary C integers (exposed via `foreign` and `compile` blocks)
without overflow check, instead of using the unary Nat from the
standard library. For Haskell, we use the fixed-precision Int
instead of the arbitrary-precision Integer.
* For the simplest benchmark programs without heap memory allocation
(e.g. `fibonacci`, `combinations`), the performance of "Current
Juvix" is comparable to or better than that of "New Juvix
runtime". This is because `clang` managed to eliminate (tail)
recursion and optimise the code to essentially the same or better
thing. The main problem with the current "direct" transpilation to C
approach is that it cannot scale to reliably work for more complex
programs. By "more complex" I mean larger program size, more
functions, more complex patterns of recursion and/or the use of more
functional programming features (including functional data
structures). I don't mean higher computational complexity or more
resource use.
* The segfaults and runtime errors for "Current Juvix" are
consequences of incorrectly generated code (current compilation of
partial application is not entirely correct) or stack overflows
(when `clang` didn't figure out how to eliminate tail recursion).
* The comparison with "Current Juvix" is not entirely fair for
benchmarks that test the manipulation and calling of closures
(e.g. `fold`). Current Juvix achieves good performance (when it
doesn't segfault) at the expense of correctness: partial application
is not compiled correctly and fixing this would require a
fundamental change in closure representation.
* The comparison with Haskell and OCaml compilers is not entirely
fair, because the new Juvix runtime does not perform garbage
collection. With the GC overhead, I would expect the Juvix runtime
results for native compilation of first-order programs to become a
bit worse than the native OCaml versions. The GC overhead is
particularly noticeable for the `mergesort` benchmark which creates
many large intermediate lists. The memory usage of the Juvix runtime
is much higher on this benchmark than the memory usage of OCaml or
Haskell versions. The relatively small time difference between the
OCaml native and bytecode versions of `mergesort` also indicates
that GC accounts for a significant part of the running time.
* Another small overhead will be introduced by bounds checking for
integer operations. Currently, the new Juvix runtime operates on
unboxed 31-bit (or 63-bit) integers without checking for integer
overflow.
* If we decide to default to transparent arbitrary-precision integers,
then another small overhead will be introduced by the need to check
the integer representation with each arithmetic operation.
* Admittedly, the programs were deliberately written in a way to make
high-level optimisations unnecessary, except specialisation for
higher-order functions (mostly in `ackermann` and `mapfun`). This
also explains the good performance of the OCaml native compiler
which doesn't do much high-level optimisation.
* In the "Current Juvix" and OCaml version of `mergesort`, to avoid
stack overflow the `merge` function was written tail-recursively
with accumulator reversal at the end. This is not necessary for the
new Juvix runtime, because the stack is dynamically extended when
needed.
* As evidenced by the `combinations` benchmark, for non-tail-recursive
direct calls our code performs worse than the code which uses the C
/ WebAssembly stack and function call mechanisms. However, in
general it is impossible to directly use the C / WebAssembly stack
and call mechanisms for a purely functional language. Since we
dynamically allocate the stack segments when needed, stack overflow
is impossible. This is convenient in an eager functional
language. Otherwise, one needs to rewrite all functions operating on
large data to use tail recursion. We pay for this convenience with a
small overhead, which is the main reason for poorer performance on
`combinations` where stack manipulation cost dominates.
* Haskell's laziness seems to introduce more overhead than I
expected. This would explain the comparatively better performance of
the native OCaml compiler. The problem is particularly stark when
Haskell's strictness analysis fails for some reason, as in the
`fibonacci` benchmark. The second "Haskell" column with the
"-XStrict" flag for GHC indicates the version of the benchmark
compiled with strictness as the default.
* The C versions of the programs were written to take advantage of C's
imperative features, e.g., using arrays instead of lists, loops
instead of recursion. No C versions are provided for some benchmarks
designed to test specifically functional language features.
* With the new Juvix runtime, the 32-bit WebAssembly version of
`mergesort` is faster than the 64-bit native version because it
needs roughly half as much memory (the word size is 4 bytes instead
of 8). The difference is even starker between the WebAssembly and
native versions of `mergesort` for "Current Juvix".
* There seems to be a memory leak in the JuvixCore evaluator. This is
what happens too often when one uses a lazy language.
* Haskell also leaks memory in the Fibonacci benchmark, despite it
being a simple tail-recursive program. It seems strictness analysis
didn't work.

55
runtime/Makefile Normal file
View File

@ -0,0 +1,55 @@
all: release debug includes
release: wasm32-wasi native64
debug: wasm32-wasi-debug native64-debug
HEADERS := $(patsubst src/%,include/%,$(shell find src -name '*.h'))
includes: $(HEADERS)
$(HEADERS) : include/%.h : src/%.h
@mkdir -p `dirname $@`
@cp $< $@
wasm32:
$(MAKE) -f Makefile.generic CONFIG=WASM32+RELEASE
wasm32-wasi:
$(MAKE) -f Makefile.generic CONFIG=WASM32-WASI+RELEASE
native32:
$(MAKE) -f Makefile.generic CONFIG=NATIVE32+RELEASE
native64:
$(MAKE) -f Makefile.generic CONFIG=NATIVE64+RELEASE
x86_32:
$(MAKE) -f Makefile.generic CONFIG=X86_32+RELEASE
wasm32-debug:
$(MAKE) -f Makefile.generic CONFIG=WASM32+DEBUG
wasm32-wasi-debug:
$(MAKE) -f Makefile.generic CONFIG=WASM32-WASI+DEBUG
native32-debug:
$(MAKE) -f Makefile.generic CONFIG=NATIVE32+DEBUG
native64-debug:
$(MAKE) -f Makefile.generic CONFIG=NATIVE64+DEBUG
x86_32-debug:
$(MAKE) -f Makefile.generic CONFIG=X86_32+DEBUG
asm:
$(MAKE) -f Makefile.generic CONFIG=ASM+DEBUG
format:
@clang-format -i `find src -name '*.c' -or -name '*.h'`
clean:
@-rm -rf _build*
@-rm -rf include
.PHONY: release debug includes wasm32 wasm32-wasi native32 native64 x86_32 wasm32-debug wasm32-wasi-debug native32-debug native64-debug x86_32-debug asm format clean

313
runtime/Makefile.generic Normal file
View File

@ -0,0 +1,313 @@
# CMakefile: generic automatic Makefile for C and C++
#
# See https://github.com/lukaszcz/cmakefile for the latest version.
#
# Copyright (C) 2008-2022 by Lukasz Czajka.
#
# Distributed under the MIT license. See the bottom of this file.
#
MAKEFILE := $(lastword $(MAKEFILE_LIST))
WORD := [[:graph:]]*[[:space:]][[:space:]]*
CAT_PROJECT := (if [ -f PROJECT ]; then cat PROJECT | sed "s/^\#.*//"; else echo ""; fi)
mstrip = $(patsubst [[:space:]]*%[[:space:]]*,%,$(1))
lsdirs = $(foreach dir,$(2),$(foreach file,$(wildcard $(dir)/*.$(1)),$(file)))
getopt = $(call mstrip,$(shell $(CAT_PROJECT) | sed -n "s/^[[:space:]]*$(1)[[:space:]]*=[[:space:]]*\(.*\)/\1/p"))
getpopt = $(call mstrip,$(foreach cfg,$(1),$(shell $(CAT_PROJECT) | sed -n "s/^[[:space:]]*\($(WORD)\)*$(cfg)[[:space:]][[:space:]]*\($(WORD)\)*$(2)[[:space:]]*=[[:space:]]*\(.*\)/\3/p")))
# build configuration
CONFIG := $(call getopt,CONFIG)
override CONFIG := $(sort $(strip $(subst +, ,$(CONFIG)) $(CONFIG)))
ifeq ($(CONFIG),)
getcopt = $(call getopt,$(1))
getropt = $(call getopt,$(1))
else
getcopt = $(call mstrip,$(call getopt,$(1)) $(call getpopt,$(CONFIG),$(1)))
getropt = $(if $(call getpopt,$(CONFIG),$(1)),$(call getpopt,$(CONFIG),$(1)),$(call getopt,$(1)))
endif
# getcopt gets a concatenable option; getropt a replaceable option
CC := $(call getropt,CC)
ifeq ($(CC),)
CC := gcc
endif
CXX := $(call getropt,CXX)
ifeq ($(CXX),)
CXX := g++
endif
YACC := $(call getropt,YACC)
ifeq ($(YACC),)
YACC := bison
endif
LEX := $(call getropt,LEX)
ifeq ($(LEX),)
LEX := flex
endif
CFLAGS := $(call getcopt,CFLAGS) $(CFLAGS)
CXXFLAGS := $(call getcopt,CXXFLAGS) $(CXXFLAGS)
CDEPFLAGS := $(call getcopt,CDEPFLAGS) $(CDEPFLAGS)
ifeq ($(strip $(CDEPFLAGS)),)
CDEPFLAGS := $(CFLAGS)
endif
CXXDEPFLAGS := $(call getcopt,CXXDEPFLAGS) $(CXXDEPFLAGS)
ifeq ($(strip $(CXXDEPFLAGS)),)
CXXDEPFLAGS := $(CXXFLAGS)
endif
LDFLAGS := $(call getcopt,LDFLAGS) $(LDFLAGS)
CCLDFLAGS := $(call getcopt,CCLDFLAGS) $(LDFLAGS) $(CCLDFLAGS)
CXXLDFLAGS := $(call getcopt,CXXLDFLAGS) $(LDFLAGS) $(CXXLDFLAGS)
YFLAGS := $(call getcopt,YFLAGS) $(YFLAGS)
ifeq ($(strip $(YFLAGS)),)
YFLAGS := -d
endif
LEXFLAGS := $(call getcopt,LEXFLAGS) $(LEXFLAGS)
LIBFLAGS := $(call getcopt,LIBFLAGS) $(LIBFLAGS)
ifeq ($(strip $(LIBFLAGS)),)
LIBFLAGS := -static -o
endif
# source directory
SRCDIR := $(call getropt,SRCDIR)
ifeq ($(SRCDIR),)
SRCDIR := $(shell if [ -d src ]; then echo "src/"; else echo ""; fi)
else
override SRCDIR := $(SRCDIR)/
endif
ifeq ($(SRCDIR),./)
BUILDDIR :=
endif
ifeq ($(SRCDIR),.//)
BUILDDIR :=
endif
ifneq ($(SRCDIR),)
INCLUDES := $(call mstrip,-I$(SRCDIR) $(INCLUDES))
endif
# build directory
BUILDDIR := $(call getropt,BUILDDIR)
ifeq ($(BUILDDIR),)
BUILDDIR := _build/
else
override BUILDDIR := $(BUILDDIR)/
endif
ifeq ($(BUILDDIR),./)
BUILDDIR :=
endif
ifeq ($(BUILDDIR),.//)
BUILDDIR :=
endif
ifneq ($(BUILDDIR),)
INCLUDES := $(call mstrip,-I$(BUILDDIR)$(SRCDIR) $(INCLUDES))
ifeq ($(SRCDIR),)
INCLUDES := $(call mstrip,-I. $(INCLUDES))
endif
endif
# update flags
ifneq ($(INCLUDES),)
CFLAGS := $(INCLUDES) $(CFLAGS)
CXXFLAGS := $(INCLUDES) $(CXXFLAGS)
CDEPFLAGS := $(INCLUDES) $(CDEPFLAGS)
CXXDEPFLAGS := $(INCLUDES) $(CXXDEPFLAGS)
endif
# library to create
LIB := $(call getropt,LIB)
ifneq ($(LIB),)
LIB := $(BUILDDIR)lib$(LIB).a
endif
# programs to create
PROGRAMS := $(patsubst %,$(BUILDDIR)$(SRCDIR)%,$(call getcopt,PROGRAMS))
# subdirectories of the source directory
SUBDIRS := $(call getcopt,SUBDIRS)
override SUBDIRS := $(patsubst %,$(SRCDIR)%,$(SUBDIRS))
# recursive subdirectories of the source directory
RSUBDIRS := $(call getcopt,RSUBDIRS)
override RSUBDIRS := $(patsubst %,$(SRCDIR)%,$(RSUBDIRS))
override SUBDIRS := $(strip $(SUBDIRS) $(foreach dir,$(RSUBDIRS),$(shell find $(dir) -type d)))
# files to ignore
IGNORE := $(patsubst %,$(SRCDIR)%,$(call getcopt,IGNORE))
# source files
YSOURCES := $(filter-out $(IGNORE),$(wildcard $(SRCDIR)*.y) $(call lsdirs,y,$(SUBDIRS)))
LEXSOURCES := $(filter-out $(IGNORE),$(wildcard $(SRCDIR)*.lex) $(call lsdirs,lex,$(SUBDIRS)))
CYSOURCES := $(patsubst %.y,$(BUILDDIR)%.c,$(YSOURCES))
HYSOURCES := $(patsubst %.y,$(BUILDDIR)%.h,$(YSOURCES))
CLEXSOURCES := $(patsubst %.lex,$(BUILDDIR)%.c,$(LEXSOURCES))
CSOURCES := $(filter-out $(IGNORE) $(CYSOURCES) $(CLEXSOURCES),$(strip $(sort $(wildcard $(SRCDIR)*.c) $(call lsdirs,c,$(SUBDIRS)))))
ALLCSOURCES := $(filter-out $(IGNORE),$(strip $(CSOURCES) $(CYSOURCES) $(CLEXSOURCES)))
CPPSOURCES := $(filter-out $(IGNORE),$(strip $(wildcard $(SRCDIR)*.cpp) $(call lsdirs,cpp,$(SUBDIRS))))
CXXSOURCES := $(filter-out $(IGNORE),$(strip $(wildcard $(SRCDIR)*.cxx) $(call lsdirs,cxx,$(SUBDIRS))))
CCSOURCES := $(filter-out $(IGNORE),$(strip $(wildcard $(SRCDIR)*.cc) $(call lsdirs,cc,$(SUBDIRS))))
ALLCPPSOURCES := $(strip $(CPPSOURCES) $(CXXSOURCES) $(CCSOURCES))
# all object files (sort to remove duplicates, which may exist from
# previous builds in a different directory)
COBJECTS := $(sort $(patsubst %.c,$(BUILDDIR)%.o,$(CSOURCES)) $(patsubst %.c,%.o,$(CYSOURCES) $(CLEXSOURCES)))
CPPOBJECTS := $(patsubst %.cpp,$(BUILDDIR)%.o,$(CPPSOURCES))
CXXOBJECTS := $(patsubst %.cxx,$(BUILDDIR)%.o,$(CXXSOURCES))
CCOBJECTS := $(patsubst %.cc,$(BUILDDIR)%.o,$(CCSOURCES))
ALLCPPOBJECTS := $(strip $(CPPOBJECTS) $(CXXOBJECTS) $(CCOBJECTS))
ALLOBJECTS := $(strip $(COBJECTS) $(ALLCPPOBJECTS))
# object files which contain the "main" function
ifneq ($(strip $(CSOURCES)),)
CMAINOBJECTS := $(patsubst %.c,$(BUILDDIR)%.o,$(shell egrep -l '\bint[[:space:]]+main\b' $(CSOURCES)))
else
CMAINOBJECTS :=
endif
ifneq ($(strip $(CPPSOURCES)),)
CPPMAINOBJECTS := $(patsubst %.cpp,$(BUILDDIR)%.o,$(shell egrep -l '\bint[[:space:]]+main\b' $(CPPSOURCES)))
else
CPPMAINOBJECTS :=
endif
ifneq ($(strip $(CXXSOURCES)),)
CXXMAINOBJECTS := $(patsubst %.cxx,$(BUILDDIR)%.o,$(shell egrep -l 'int[[:space:]]+main\b' $(CXXSOURCES)))
else
CXXMAINOBJECTS :=
endif
ifneq ($(strip $(CCSOURCES)),)
CCMAINOBJECTS := $(patsubst %.cxx,$(BUILDDIR)%.o,$(shell egrep -l 'int[[:space:]]+main\b' $(CCSOURCES)))
else
CCMAINOBJECTS :=
endif
ifneq ($(PROGRAMS),)
MAINOBJECTS := $(patsubst %,%.o,$(PROGRAMS))
CPROGRAMS := $(filter $(PROGRAMS),$(patsubst %.o,%,$(COBJECTS)))
CPPPROGRAMS := $(filter $(PROGRAMS),$(patsubst %.o,%,$(ALLCPPOBJECTS)))
else ifneq ($(LIB),)
MAINOBJECTS :=
CPROGRAMS :=
CPPPROGRAMS :=
else
MAINOBJECTS := $(CMAINOBJECTS) $(CPPMAINOBJECTS) $(CXXMAINOBJECTS) $(CCMAINOBJECTS)
CPROGRAMS := $(patsubst %.o,%,$(CMAINOBJECTS))
CPPPROGRAMS := $(patsubst %.o,%,$(CPPMAINOBJECTS)) $(patsubst %.o,%,$(CXXMAINOBJECTS)) $(patsubst %.o,%,$(CCMAINOBJECTS))
PROGRAMS := $(patsubst %.o,%,$(MAINOBJECTS))
endif
# dependencies for each source file
CDEPENDS := $(patsubst %.c,$(BUILDDIR)%.d,$(CSOURCES))
CYLDEPENDS := $(patsubst %.c,%.d,$(CYSOURCES)) $(patsubst %.c,%.d,$(CLEXSOURCES))
CPPDEPENDS := $(patsubst %.cpp,$(BUILDDIR)%.d,$(CPPSOURCES))
CXXDEPENDS := $(patsubst %.cxx,$(BUILDDIR)%.d,$(CXXSOURCES))
CCDEPENDS := $(patsubst %.cc,$(BUILDDIR)%.d,$(CCSOURCES))
DEPENDS := $(sort $(CDEPENDS) $(CYLDEPENDS) $(CPPDEPENDS) $(CXXDEPENDS) $(CCDEPENDS))
# object files which don't include the "main" function
OBJECTS := $(filter-out $(MAINOBJECTS),$(ALLOBJECTS))
# linkers
CCLD := $(call getropt,CCLD)
ifeq ($(CCLD),)
ifeq ($(ALLCPPSOURCES),)
CCLD := $(CC)
else
CCLD := $(CXX)
endif
endif
CXXLD := $(call getropt,CXXLD)
ifeq ($(CXXLD),)
CXXLD := $(CXX)
endif
LIBTOOL := $(call getropt,LIBTOOL)
ifeq ($(LIBTOOL),)
LIBTOOL := libtool
endif
ifneq ($(BUILDDIR),)
$(shell mkdir -p $(BUILDDIR))
$(shell mkdir -p $(BUILDDIR)$(SRCDIR))
$(foreach dir,$(patsubst %,$(BUILDDIR)%,$(SUBDIRS)),$(shell mkdir -p $(dir)))
endif
.PHONY: all depend clean
all: $(DEPENDS) $(OBJECTS) $(PROGRAMS) $(LIB)
depend: $(DEPENDS)
$(HYSOURCES) : $(BUILDDIR)%.h : %.y
$(YACC) $(YFLAGS) -o $(patsubst %.h,%.c,$@) $<
$(CYSOURCES) : $(BUILDDIR)%.c : %.y
$(YACC) $(YFLAGS) -o $@ $<
$(CLEXSOURCES) : $(BUILDDIR)%.c : %.lex
$(LEX) $(LEXFLAGS) -o $@ $<
$(CDEPENDS) : $(BUILDDIR)%.d : %.c
$(CC) $(CDEPFLAGS) -MM -MT $(patsubst %.c,$(BUILDDIR)%.o,$<) $< > $@
printf "\t$(CC) -c $(CFLAGS) -o $(patsubst %.c,$(BUILDDIR)%.o,$<) $<\n" >> $@
$(CYLDEPENDS) : $(BUILDDIR)%.d : $(BUILDDIR)%.c
$(CC) $(CDEPFLAGS) -MM -MT $(patsubst %.c,%.o,$<) $< > $@
printf "\t$(CC) -c $(CFLAGS) -o $(patsubst %.c,%.o,$<) $<\n" >> $@
$(CPPDEPENDS) : $(BUILDDIR)%.d : %.cpp
$(CXX) $(CXXDEPFLAGS) -MM -MT $(patsubst %.cpp,$(BUILDDIR)%.o,$<) $< > $@
printf "\t$(CXX) -c $(CXXFLAGS) -o $(patsubst %.cpp,$(BUILDDIR)%.o,$<) $<\n" >> $@
$(CXXDEPENDS) : $(BUILDDIR)%.d : %.cxx
$(CXX) $(CXXDEPFLAGS) -MM -MT $(patsubst %.cxx,$(BUILDDIR)%.o,$<) $< > $@
printf "\t$(CXX) -c $(CXXFLAGS) -o $(patsubst %.cxx,$(BUILDDIR)%.o,$<) $<\n" >> $@
$(CCDEPENDS) : $(BUILDDIR)%.d : %.cc
$(CXX) $(CXXDEPFLAGS) -MM -MT $(patsubst %.cc,$(BUILDDIR)%.o,$<) $< > $@
printf "\t$(CXX) -c $(CXXFLAGS) -o $(patsubst %.cc,$(BUILDDIR)%.o,$<) $<\n" >> $@
$(CPROGRAMS) : % : $(ALLOBJECTS)
$(CCLD) -o $@ $@.o $(OBJECTS) $(CCLDFLAGS)
$(CPPPROGRAMS) : % : $(ALLOBJECTS)
$(CXXLD) -o $@ $@.o $(OBJECTS) $(CXXLDFLAGS)
$(LIB) : % : $(OBJECTS)
$(LIBTOOL) $(LIBFLAGS) $@ $(OBJECTS)
include $(DEPENDS)
clean:
-rm -f $(PROGRAMS) $(ALLOBJECTS) $(DEPENDS) $(LIB) $(CYSOURCES) $(HYSOURCES) $(CLEXSOURCES)
ifneq ($(wildcard $(BUILDDIR).prjconfig),)
-rm $(BUILDDIR).prjconfig
endif
ifneq ($(BUILDDIR),)
-rm -rf $(BUILDDIR)
endif
ifneq ($(wildcard PROJECT),)
$(MAKEFILE): $(DEPENDS) $(BUILDDIR).prjconfig
$(BUILDDIR).prjconfig: PROJECT
-rm -f $(PROGRAMS) $(ALLOBJECTS) $(DEPENDS) $(LIB) $(CYSOURCES) $(HYSOURCES) $(CLEXSOURCES)
touch $(BUILDDIR).prjconfig
else
$(MAKEFILE): $(DEPENDS)
endif
ifneq ($(wildcard Makefile-include),)
include Makefile-include
endif
# Copyright (c) 2008-2022 by Lukasz Czajka.
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

34
runtime/PROJECT Normal file
View File

@ -0,0 +1,34 @@
RSUBDIRS = juvix
CC = clang
CFLAGS = -std=c11 -W -Wall -Wno-unused-parameter -Werror
LIBTOOL = llvm-ar
LIBFLAGS = csru
LIB = juvix
RELEASE CFLAGS = -DNDEBUG
DEBUG CFLAGS = -DDEBUG
WASM32+RELEASE BUILDDIR = _build.wasm32
WASM32+DEBUG BUILDDIR = _build.wasm32-debug
WASM32 CFLAGS = -Os --target=wasm32 -DARCH_WASM32 -DAPI_NONE
WASM32-WASI+RELEASE BUILDDIR = _build.wasm32-wasi
WASM32-WASI+DEBUG BUILDDIR = _build.wasm32-wasi-debug
WASM32-WASI CFLAGS = -Os --target=wasm32-wasi -DARCH_WASM32 -DAPI_WASI
NATIVE32+RELEASE BUILDDIR = _build.native32
NATIVE32+DEBUG BUILDDIR = _build.native32-debug
NATIVE32 CFLAGS = -O3 -m32 -DARCH_NATIVE32 -DAPI_LIBC
NATIVE64+RELEASE BUILDDIR = _build.native64
NATIVE64+DEBUG BUILDDIR = _build.native64-debug
NATIVE64 CFLAGS = -O3 -m64 -DARCH_NATIVE64 -DAPI_LIBC
X86_32+RELEASE BUILDDIR = _build.x86_32
X86_32+DEBUG BUILDDIR = _build.x86_32-debug
X86_32 CFLAGS = -O3 -fomit-frame-pointer --target=i386 -DARCH_NATIVE32 -DAPI_LIBC
ASM BUILDDIR = _build.asm
ASM CFLAGS = -S -O0 --target=i386 -DARCH_NATIVE32 -DAPI_LIBC

137
runtime/src/juvix/api.h Normal file
View File

@ -0,0 +1,137 @@
#ifndef JUVIX_API_H
#define JUVIX_API_H
#include <juvix/funcall.h>
#include <juvix/info.h>
#include <juvix/io.h>
#include <juvix/mem.h>
#include <juvix/object.h>
#define JUVIX_INIT \
MEM_INIT; \
funcall_init()
// MAX_ARGS is the maximum number of function arguments, at least 1.
// ARG_DECLS declares the argument variables (using DECL_ARG and DECL_REG_ARG
// from funcall/funcall.h)
#define JUVIX_PROLOGUE(MAX_ARGS, ARG_DECLS) \
MEM_DECLS; \
ARG_DECLS; \
FUNCALL_DECLS(MAX_ARGS); \
JUVIX_INIT; \
STACK_PUSH_ADDR(LABEL_ADDR(juvix_program_end)); \
goto juvix_program_start; \
DECL_CALL_CLOSURES; \
juvix_program_start:
#define JUVIX_EPILOGUE \
juvix_program_end: \
STACK_POPT; \
IO_INTERPRET; \
io_print_toplevel(juvix_result);
// Temporary vars
#define DECL_TMP(k) word_t juvix_tmp_##k
#define TMP(k) juvix_tmp_##k
// Value stack temporary vars
#define DECL_STMP(k) word_t juvix_stmp_##k
#define STMP(k) juvix_stmp_##k
// Begin a function definition. `max_stack` is the maximum stack allocation in
// the function.
#define JUVIX_FUNCTION(label, max_stack) \
label: \
STACK_ENTER((max_stack))
/*
Macro sequence for function definition:
closure_label:
ARG(0) = CARG(0);
...
ARG(m) = CARG(m);
JUVIX_FUNCTION(function_label, max_stack);
{
DECL_TMP(0);
DECL_TMP(1);
...
DECL_TMP(max_tmp-1);
<code>
}
*/
// Begin a function with no stack allocation.
#define JUVIX_FUNCTION_NS(label) \
label:
#define JUVIX_INT_ADD(var0, var1, var2) (var0 = smallint_add(var1, var2))
#define JUVIX_INT_SUB(var0, var1, var2) (var0 = smallint_sub(var1, var2))
#define JUVIX_INT_MUL(var0, var1, var2) (var0 = smallint_mul(var1, var2))
#define JUVIX_INT_DIV(var0, var1, var2) (var0 = smallint_div(var1, var2))
#define JUVIX_INT_MOD(var0, var1, var2) (var0 = smallint_mod(var1, var2))
#define JUVIX_INT_LT(var0, var1, var2) (var0 = smallint_lt(var1, var2))
#define JUVIX_INT_LE(var0, var1, var2) (var0 = smallint_le(var1, var2))
#define JUVIX_INT_EQ(var0, var1, var2) (var0 = make_bool(var1 == var2))
#define JUVIX_VAL_EQ(var0, var1, var2) \
(var0 = make_bool(juvix_equal(var1, var2)))
#define JUVIX_ASSIGN(var0, val) (var0 = val)
#define JUVIX_TRACE(val) (io_print_toplevel(val))
#define JUVIX_DUMP (stacktrace_dump())
#define JUVIX_FAILURE(val) \
do { \
io_print_toplevel(val); \
error_exit(); \
} while (0)
#define JUVIX_ALLOC_INT(var, val) (var = make_smallint(val))
// ALLOC_CONSTR_BOXED(var, uid, nfields)
// ALLOC_CONSTR_BOXED_TAG(var, uid)
// ALLOC_CONSTR_UNBOXED(var, uid)
// ALLOC_CONSTR_PAIR(var)
// ALLOC_CSTRING(var, str)
// ALLOC_CLOSURE(var, fuid, addr, nargs, largs)
// EXTEND_CLOSURE(dest, src, n)
// CALL(fuid, fun_label, return_label)
// TAIL_CALL(fuid, fun_label)
// CALL_CLOSURE(cl)
// TAIL_CALL_CLOSURE(cl)
// CALL_CLOSURES(nargs, return_label)
// TAIL_CALL_CLOSURES(nargs)
// RETURN
#define JUVIX_BRANCH(val, CODE_TRUE, CODE_FALSE) \
if (is_true(val)) { \
CODE_TRUE; \
} else { \
CODE_FALSE; \
}
/*
Compilation of the `Case` instruction:
switch (var) {
case UNBOXED_CONSTR_HEADER_1: {<code>}; break;
...
case UNBOXED_CONSTR_HEADER_N: {<code>}; break;
default:
switch (get_header(var)) {
case BOXED_CONSTR_HEADER_1: {<code>}; break;
...
case BOXED_CONSTR_HEADER_M: {<code>}; break;
default:
<code> (or UNREACHABLE)
}
}
Single-branch switches shouldn't be output.
*/
#endif

123
runtime/src/juvix/arch/defs.h Normal file
View File

@ -0,0 +1,123 @@
#ifndef JUVIX_ARCH_DEFS_H
#define JUVIX_ARCH_DEFS_H
#include <juvix/config.h>
// Number of bits in a word
#if defined(ARCH_WASM32) || defined(ARCH_NATIVE32)
#define BITS32
#elif defined(ARCH_NATIVE64)
#define BITS64
#else
#error "Unsupported configuration"
#endif
// Detect compiler
#ifdef __GNUC__
#ifdef __clang__
#define COMPILER_CLANG
#else
#define COMPILER_GCC
#endif
#endif
#if defined(COMPILER_CLANG) || defined(COMPILER_GCC)
#define EXT_LABELS_AS_VALUES
#endif
#if defined(COMPILER_GCC) || defined(COMPILER_CLANG)
#define likely(exp) (__builtin_expect((exp), 1))
#define unlikely(exp) (__builtin_expect((exp), 0))
#else
#define likely(exp) (exp)
#define unlikely(exp) (exp)
#endif
#if defined(COMPILER_CLANG) || defined(COMPILER_GCC)
#define UNREACHABLE __builtin_unreachable()
#else
#define UNREACHABLE \
do { \
} while (0)
#endif
#if defined(COMPILER_CLANG) || defined(COMPILER_GCC)
#define UNUSED __attribute__((unused))
#else
#define UNUSED
#endif
// typedefs for basic integer types
#if (defined(COMPILER_CLANG) || defined(COMPILER_GCC)) && !defined(API_LIBC)
typedef __SIZE_TYPE__ size_t;
typedef __UINT8_TYPE__ uint8_t;
typedef __UINT16_TYPE__ uint16_t;
typedef __UINT32_TYPE__ uint32_t;
typedef __UINT64_TYPE__ uint64_t;
typedef __INT32_TYPE__ int32_t;
typedef __INT64_TYPE__ int64_t;
typedef __UINTPTR_TYPE__ uintptr_t;
#elif defined(API_LIBC)
#include <stdint.h>
#else
#error "Unsupported configuration"
#endif
typedef unsigned uint;
// typedefs for word_t, dword_t, int_t, long_t
#if defined(BITS32)
typedef uint32_t word_t;
typedef uint64_t dword_t;
typedef int32_t int_t;
typedef int64_t long_t;
#elif defined(BITS64)
typedef uint64_t word_t;
typedef int64_t int_t;
#ifdef __SIZEOF_INT128__
typedef unsigned __int128 dword_t;
typedef __int128 long_t;
#else
#error "Unsupported configuration"
#endif
#else
#error "Unsupported configuration"
#endif
// PAGE_SIZE_LOG2 must be at least 16
#define PAGE_SIZE_LOG2 16U
#define PAGE_SIZE (1U << PAGE_SIZE_LOG2)
#define PAGE_MASK (PAGE_SIZE - 1U)
// NULL
#ifndef NULL
#define NULL ((void *)0)
#endif
#ifdef API_LIBC
#include <stdbool.h>
#else
typedef int bool;
#define true 1
#define false 0
#endif
#ifdef EXT_LABELS_AS_VALUES
#define LABEL_ADDR(label) &&label
#define STORED_GOTO(ptr) goto *(ptr)
typedef void *label_addr_t;
#else
#error \
"The \"labels as values\" compiler extension is required (use GCC or clang)."
#endif
#endif

17
runtime/src/juvix/arch/wasi.c Normal file
View File

@ -0,0 +1,17 @@
#include <juvix/arch/wasi.h>
#ifdef API_WASI
_Noreturn void exit(int code) { proc_exit(code); }
void puts(const char *msg) {
size_t n = 0;
while (msg[n]) ++n;
ciovec_t vec = {.buf = (uint8_t *)msg, .buf_len = n};
fd_write(1, &vec, 1, 0);
uint8_t c = '\n';
ciovec_t vec1 = {.buf = &c, .buf_len = 1};
fd_write(1, &vec1, 1, 0);
}
#endif

33
runtime/src/juvix/arch/wasi.h Normal file
View File

@ -0,0 +1,33 @@
#ifndef JUVIX_ARCH_WASI_H
#define JUVIX_ARCH_WASI_H
#include <juvix/arch/defs.h>
#ifdef API_WASI
_Noreturn void exit(int code);
void puts(const char *str);
typedef struct Ciovec {
uint8_t *buf;
uint32_t buf_len;
} ciovec_t;
uint16_t fd_write(uint32_t fd, ciovec_t *iovs_ptr, uint32_t iovs_len,
uint32_t *nwritten)
__attribute__((__import_module__("wasi_snapshot_preview1"),
__import_name__("fd_write"), ));
uint16_t fd_read(uint32_t fd, ciovec_t *iovs_ptr, uint32_t iovs_len,
uint32_t *read)
__attribute__((__import_module__("wasi_snapshot_preview1"),
__import_name__("fd_read"), ));
_Noreturn void proc_exit(uint32_t rval)
__attribute__((__import_module__("wasi_snapshot_preview1"),
__import_name__("proc_exit"), ));
#endif
#endif

27
runtime/src/juvix/config.h Normal file
View File

@ -0,0 +1,27 @@
/*
* This file contains global configuration defines. These defines are normally
* generated by the compiler. The file here only documents the available values.
*/
#if !defined(ARCH_WASM32) && !defined(ARCH_NATIVE32) && !defined(ARCH_NATIVE64)
#define ARCH_WASM32
// #define ARCH_NATIVE32
// #define ARCH_NATIVE64
#endif
#if !defined(API_LIBC) && !defined(API_WASI) && !defined(API_ANOMA) && \
!defined(API_COSM) && !defined(API_NONE)
#define API_WASI
// #define API_LIBC
// #define API_ANOMA
// #define API_COSM
// #define API_NONE
#endif
#if !defined(DEBUG) && !defined(NDEBUG)
#define DEBUG
// #define NDEBUG
#endif
// #define NO_GC

88
runtime/src/juvix/defs.h Normal file
View File

@ -0,0 +1,88 @@
#ifndef JUVIX_DEFS_H
#define JUVIX_DEFS_H
#include <juvix/arch/defs.h>
#ifdef API_LIBC
#include <stdio.h>
#include <stdlib.h>
#endif
#ifdef API_WASI
#include <juvix/arch/wasi.h>
#endif
/**********************************************/
/* Basic primitive functions and macros */
static void print_msg(const char *msg) {
#if defined(API_LIBC) || defined(API_WASI)
puts(msg);
#endif
}
_Noreturn static inline void error_exit() {
#if defined(API_LIBC)
abort();
#elif defined(ARCH_WASM32)
__builtin_trap();
#endif
}
_Noreturn static inline void error_exit_msg(const char *msg) {
print_msg(msg);
error_exit();
}
// Debug assertions
#ifdef DEBUG
#define STRINGIFY(x) #x
#define TOSTRING(x) STRINGIFY(x)
#define ASSERT(x) \
do { \
if (!(x)) \
error_exit_msg(__FILE__ ":" TOSTRING( \
__LINE__) ": Juvix assertion failed. Please report."); \
} while (0)
#else
#define ASSERT(x) \
do { \
} while (0)
#endif
#define ASSERT_EQ(a, b) ASSERT((a) == (b))
// Static assertions (requires C11)
#define STATIC_ASSERT(x) _Static_assert((x), "assertion failed")
#define STATIC_ASSERT_EQ(a, b) STATIC_ASSERT((a) == (b))
static inline size_t max(size_t a, size_t b) { return a < b ? b : a; }
// `alignment` must be a power of 2
static inline uintptr_t align(uintptr_t val, uintptr_t alignment) {
return (val + alignment - 1) & ~(alignment - 1);
}
static inline void *palign(void *ptr, uintptr_t alignment) {
return (void *)align((uintptr_t)ptr, alignment);
}
// `y` must be a power of 2
#define ASSERT_ALIGNED(x, y) ASSERT(((uintptr_t)(x) & ((uintptr_t)(y)-1)) == 0)
#if defined(API_LIBC) && defined(DEBUG)
#define LOG(...) fprintf(stderr, __VA_ARGS__)
#else
#define LOG(...) \
do { \
} while (0)
#endif
/*************************************************************************/
/* Static assertions */
#if defined(BITS32)
STATIC_ASSERT_EQ(sizeof(void *), 4);
#elif defined(BITS64)
STATIC_ASSERT_EQ(sizeof(void *), 8);
#else
#error "Unsupported configuration"
#endif
#endif

13
runtime/src/juvix/funcall.h Normal file
View File

@ -0,0 +1,13 @@
#ifndef JUVIX_FUNCALL_H
#define JUVIX_FUNCALL_H
#include <juvix/funcall/funcall.h>
#include <juvix/funcall/stacktrace.h>
#define FUNCALL_DECLS(MAX_ARGS) \
DECL_RESULT; \
DECL_CARGS(MAX_ARGS)
static inline void funcall_init() { stacktrace_init(); }
#endif

233
runtime/src/juvix/funcall/funcall.h Normal file
View File

@ -0,0 +1,233 @@
#ifndef JUVIX_FUNCALL_FUNCALL_H
#define JUVIX_FUNCALL_FUNCALL_H
#include <juvix/funcall/stacktrace.h>
#include <juvix/mem/stack.h>
#include <juvix/object/closure.h>
#define DECL_REG_ARG(k) register word_t juvix_arg_##k
#define DECL_ARG(k) word_t juvix_arg_##k
// Function result is stored in juvix_result
#define DECL_RESULT register word_t juvix_result
#define DECL_CARGS(MAX_ARGS) word_t juvix_carg[MAX_ARGS]
#define ARG(k) juvix_arg_##k
#define CARG(k) juvix_carg[k]
// TODO: The labels on the stack will need to have their least significant bit
// set for the GC.
#define STACK_PUSH_ADDR(addr) (STACK_PUSH(addr))
#define STACK_POP_ADDR(var) \
do { \
var = STACK_TOP_ADDR; \
STACK_POPT; \
} while (0)
#define STACK_TOP_ADDR (((label_addr_t)(STACK_TOP)))
#define STACK_PUSH_UINT(num) (STACK_PUSH(make_unboxed(num)))
#define STACK_POP_UINT(var) \
do { \
var = get_unboxed(STACK_TOP); \
STACK_POPT; \
} while (0)
/*
Macro sequence for a direct function call:
STACK_PUSH(var1);
...
STACK_PUSH(varn);
ARG(0) = arg0;
...
ARG(m) = argm;
CALL(fuid, function, unique_label);
STACK_POP(varn);
...
STACK_POP(var1);
arg0, ..., argm cannot contain references to ARG(k) for any k
*/
#define CALL(fuid, fun, label) \
STACKTRACE_PUSH(fuid); \
STACK_PUSH_ADDR(LABEL_ADDR(label)); \
goto fun; \
label: \
STACK_POPT; \
STACKTRACE_POP;
/*
Macro sequence for a direct function tail-call:
ARG(0) = arg0;
...
ARG(m) = argm;
TAIL_CALL(fuid, function);
arg0, ..., argm cannot contain references to ARG(k) for any k
*/
#define TAIL_CALL_NS(fuid, fun) \
STACKTRACE_REPLACE(fuid); \
goto fun
#define TAIL_CALL(fuid, fun) \
STACK_LEAVE; \
TAIL_CALL_NS(fuid, fun)
#define ASSIGN_CARGS(cl, CODE) \
do { \
size_t juvix_closure_nargs = get_closure_nargs(cl); \
for (size_t juvix_closure_idx = 0; \
juvix_closure_idx < juvix_closure_nargs; ++juvix_closure_idx) { \
CARG(juvix_closure_idx) = CLOSURE_ARG(cl, juvix_closure_idx); \
} \
CODE; \
} while (0)
/*
Macro sequence for an indirect function call:
STACK_PUSH(var1);
...
STACK_PUSH(varn);
ASSIGN_CARGS(cl, {
CARG(juvix_closure_nargs) = arg0;
...
CARG(juvix_closure_nargs + m) = argm;
});
CALL_CLOSURE(closure, unique_label);
STACK_POP(varn);
...
STACK_POP(var1);
arg0, ..., argm cannot contain references to CARG(k) for any k
*/
#define CALL_CLOSURE(cl, label) \
STACKTRACE_PUSH(get_closure_fuid(cl)); \
STACK_PUSH_ADDR(LABEL_ADDR(label)); \
STORED_GOTO(get_closure_addr(cl)); \
label: \
STACK_POPT; \
STACKTRACE_POP;
#define TAIL_CALL_CLOSURE_NS(cl) \
STACKTRACE_REPLACE(get_closure_fuid(cl)); \
goto *get_closure_addr(cl)
#define TAIL_CALL_CLOSURE(cl) \
STACK_LEAVE; \
TAIL_CALL_CLOSURE_NS(cl)
#define RETURN_NS STORED_GOTO(STACK_TOP_ADDR);
#define RETURN \
STACK_LEAVE; \
RETURN_NS
/*
Macro sequence for calling the dispatch loop:
STACK_PUSH(var1);
...
STACK_PUSH(varn);
STACK_PUSH(argm);
...
STACK_PUSH(arg1);
CALL_CLOSURES(closure, m, unique_label);
STACK_POP(varn);
...
STACK_POP(var1);
*/
#define CALL_CLOSURES(cl, m, label) \
juvix_ccl_sargs = m; \
juvix_ccl_return = LABEL_ADDR(label); \
juvix_ccl_closure = cl; \
goto juvix_ccl_start; \
label:
/*
Macro sequence for tail-calling the dispatch loop:
STACK_PUSH(argm);
...
STACK_PUSH(arg1);
TAIL_CALL_CLOSURES(closure, m);
*/
#define TAIL_CALL_CLOSURES(cl, m) \
juvix_ccl_sargs = m; \
juvix_ccl_return = NULL; \
juvix_ccl_closure = cl; \
goto juvix_ccl_start;
#define DECL_CALL_CLOSURES \
label_addr_t juvix_ccl_return; \
size_t juvix_ccl_sargs; \
word_t juvix_ccl_closure; \
juvix_ccl_start: \
do { \
size_t juvix_ccl_largs = get_closure_largs(juvix_ccl_closure); \
size_t juvix_ccl_nargs = get_closure_nargs(juvix_ccl_closure); \
if (juvix_ccl_largs <= juvix_ccl_sargs) { \
juvix_ccl_sargs -= juvix_ccl_largs; \
for (size_t juvix_idx = 0; juvix_idx < juvix_ccl_nargs; \
++juvix_idx) { \
CARG(juvix_idx) = CLOSURE_ARG(juvix_ccl_closure, juvix_idx); \
} \
for (size_t juvix_idx = 0; juvix_idx < juvix_ccl_largs; \
++juvix_idx) { \
STACK_POP(CARG(juvix_ccl_nargs + juvix_idx)); \
} \
if (juvix_ccl_sargs == 0 && juvix_ccl_return == NULL) { \
STACKTRACE_REPLACE(get_closure_fuid(juvix_ccl_closure)); \
STACK_LEAVE; \
STORED_GOTO(get_closure_addr(juvix_ccl_closure)); \
} else { \
STACK_PUSH_ADDR(juvix_ccl_return); \
STACK_PUSH_UINT(juvix_ccl_sargs); \
CALL_CLOSURE(juvix_ccl_closure, \
juvix_ccl_return_from_closure); \
STACK_POP_UINT(juvix_ccl_sargs); \
STACK_POP_ADDR(juvix_ccl_return); \
if (juvix_ccl_sargs > 0) { \
juvix_ccl_closure = juvix_result; \
goto juvix_ccl_start; \
} else { \
ASSERT(juvix_ccl_return != NULL); \
STORED_GOTO(juvix_ccl_return); \
} \
} \
} else { \
PREALLOC( \
juvix_ccl_nargs + CLOSURE_SKIP + 1 + juvix_ccl_sargs, \
{ \
STACK_PUSH(juvix_ccl_closure); \
STACK_PUSH_ADDR(juvix_ccl_return); \
STACK_PUSH_UINT(juvix_ccl_sargs); \
}, \
{ \
STACK_POP_UINT(juvix_ccl_sargs); \
STACK_POP_ADDR(juvix_ccl_return); \
STACK_POP(juvix_ccl_closure); \
}); \
EXTEND_CLOSURE(juvix_result, juvix_ccl_closure, juvix_ccl_sargs, { \
for (size_t juvix_idx = 0; juvix_idx < juvix_ccl_sargs; \
++juvix_idx) { \
STACK_POP(CLOSURE_ARG(juvix_result, \
juvix_closure_nargs + juvix_idx)); \
} \
}); \
if (juvix_ccl_return == NULL) { \
RETURN; \
} else { \
STORED_GOTO(juvix_ccl_return); \
} \
} \
} while (0)
#define DISPATCH_STACK_SIZE 4
#endif

69
runtime/src/juvix/funcall/stacktrace.c Normal file
View File

@ -0,0 +1,69 @@
#include <juvix/funcall/stacktrace.h>
#include <juvix/info.h>
#include <juvix/mem/pages.h>
#ifdef DEBUG
#define BUFFER_SIZE (PAGE_SIZE / sizeof(uint))
static uint *st_buffer;
static uint st_index;
static uint st_size;
void stacktrace_init() {
// TODO: use malloc / realloc once available for all APIs
st_buffer = palloc(1);
st_index = 0;
st_size = 0;
}
void stacktrace_push(uint fuid) {
st_buffer[st_index++] = fuid;
++st_size;
st_index = st_index % BUFFER_SIZE;
}
void stacktrace_replace(uint fuid) {
if (st_index > 0) {
st_buffer[st_index - 1] = fuid;
} else {
st_buffer[BUFFER_SIZE - 1] = fuid;
}
}
#define DEC(i) \
do { \
if (i > 0) { \
--i; \
} else { \
i = BUFFER_SIZE - 1; \
} \
} while (0)
void stacktrace_pop() {
DEC(st_index);
--st_size;
}
void stacktrace_dump() {
uint i = st_index;
uint s = st_size;
print_msg("Stacktrace:\n");
while (s > 0) {
DEC(i);
--s;
ASSERT(st_buffer[i] < juvix_functions_num);
print_msg(juvix_function_info[st_buffer[i]].name);
}
}
#else
void stacktrace_init() {}
void stacktrace_push(uint fuid) {}
void stacktrace_replace(uint fuid) {}
void stacktrace_pop() {}
void stacktrace_dump() { print_msg("<stacktrace not available>"); }
#endif

34
runtime/src/juvix/funcall/stacktrace.h Normal file
View File

@ -0,0 +1,34 @@
#ifndef JUVIX_FUNCALL_STACKTRACE_H
#define JUVIX_FUNCALL_STACKTRACE_H
#include <juvix/defs.h>
#ifdef DEBUG
#define STACKTRACE_PUSH(fuid) stacktrace_push(fuid)
#define STACKTRACE_REPLACE(fuid) stacktrace_replace(fuid)
#define STACKTRACE_POP stacktrace_pop()
#else
#define STACKTRACE_PUSH(fuid) \
do { \
} while (0)
#define STACKTRACE_REPLACE(fuid) \
do { \
} while (0)
#define STACKTRACE_POP \
do { \
} while (0)
#endif
void stacktrace_init();
void stacktrace_push(uint fuid);
void stacktrace_replace(uint fuid);
void stacktrace_pop();
void stacktrace_dump();
#endif

7
runtime/src/juvix/info.c Normal file
View File

@ -0,0 +1,7 @@
#include <juvix/info.h>
function_info_t *juvix_function_info = NULL;
constr_info_t *juvix_constr_info = NULL;
size_t juvix_functions_num = 0;
size_t juvix_constrs_num = 0;

19
runtime/src/juvix/info.h Normal file
View File

@ -0,0 +1,19 @@
#ifndef JUVIX_INFO_H
#define JUVIX_INFO_H
#include <juvix/defs.h>
typedef struct {
const char *name;
} function_info_t;
typedef struct {
const char *name;
} constr_info_t;
extern function_info_t *juvix_function_info;
extern constr_info_t *juvix_constr_info;
extern size_t juvix_functions_num;
extern size_t juvix_constrs_num;
#endif

144
runtime/src/juvix/io.c Normal file
View File

@ -0,0 +1,144 @@
#include <juvix/io.h>
#include <juvix/mem/pages.h>
#include <juvix/object/constr.h>
#include <juvix/object/cstring.h>
#include <juvix/object/print.h>
static char *io_buffer = NULL;
static uint io_index = 0;
void io_init() {
// TODO: use malloc and realloc once they're available for all APIs
io_buffer = palloc(1);
io_index = 0;
}
void io_flush() {
ASSERT(io_index < PAGE_SIZE);
if (io_index > 0) {
#ifdef API_LIBC
io_buffer[io_index] = 0;
if (fputs(io_buffer, stdout) == EOF) {
error_exit_msg("write error");
}
fflush(stdout);
io_index = 0;
#else
io_buffer[io_index] = 0;
print_msg(io_buffer);
io_index = 0;
#endif
}
}
static void io_write(word_t x) {
if (io_buffer == NULL) {
io_init();
}
ASSERT(io_index < PAGE_SIZE);
if (is_cstring(x)) {
const char *str = get_cstring(x);
while (*str) {
io_buffer[io_index++] = *str++;
if (io_index == PAGE_SIZE) {
io_buffer[PAGE_SIZE - 1] = 0;
print_msg(io_buffer);
error_exit_msg("error: IO buffer overflow");
}
if (io_buffer[io_index - 1] == '\n') {
io_buffer[io_index - 1] = 0;
print_msg(io_buffer);
io_index = 0;
}
}
} else {
io_index += print_to_buf(io_buffer + io_index, PAGE_SIZE - io_index, x);
if (io_index >= PAGE_SIZE) {
io_buffer[PAGE_SIZE - 1] = 0;
print_msg(io_buffer);
error_exit_msg("error: IO buffer overflow");
}
}
}
#ifdef API_WASI
static char getchar() {
uint8_t ch;
ciovec_t v = {.buf = &ch, .buf_len = 1};
if (fd_read(0, &v, 1, 0) != 0) {
error_exit_msg("read error");
}
return ch;
}
#endif
static word_t io_readln() {
if (io_buffer == NULL) {
io_init();
}
ASSERT(io_index < PAGE_SIZE);
#if defined(API_LIBC)
io_flush();
if (fgets(io_buffer, MAX_CSTRING_LENGTH - 1, stdin) == NULL) {
error_exit_msg("read error");
}
io_buffer[MAX_CSTRING_LENGTH - 1] = 0;
return alloc_cstring(io_buffer);
#elif defined(API_WASI)
io_flush();
char c = getchar();
uint i = 0;
while (c != '\n') {
if (i == MAX_CSTRING_LENGTH) {
error_exit_msg("error: string too long");
}
io_buffer[i++] = c;
c = getchar();
}
io_buffer[i] = 0;
return alloc_cstring(io_buffer);
#else
error_exit_msg("error: IO read not available");
#endif
}
void io_print_toplevel(word_t x) {
if (x != OBJ_VOID) {
io_write(x);
ASSERT(io_index < PAGE_SIZE);
io_buffer[io_index] = 0;
print_msg(io_buffer);
io_index = 0;
}
}
bool io_interpret(word_t x, word_t *ret, word_t *arg) {
if (is_ptr(x) && has_header(x)) {
switch (get_uid(x)) {
case UID_RETURN:
ASSERT(get_constr_nargs(x) == 1);
*ret = CONSTR_ARG(x, 0);
return false;
case UID_BIND:
ASSERT(get_constr_nargs(x) == 2);
*ret = CONSTR_ARG(x, 1);
*arg = CONSTR_ARG(x, 0);
return true;
case UID_WRITE:
ASSERT(get_constr_nargs(x) == 1);
io_write(CONSTR_ARG(x, 0));
*ret = OBJ_VOID;
return false;
case UID_READLN:
*ret = io_readln();
return false;
default:
*ret = x;
return false;
}
} else {
*ret = x;
return false;
}
}

44
runtime/src/juvix/io.h Normal file
View File

@ -0,0 +1,44 @@
#ifndef JUVIX_IO_H
#define JUVIX_IO_H
#include <juvix/funcall/funcall.h>
void io_init();
void io_flush();
void io_print_toplevel(word_t x);
// If the returned value is true, `ret` constains a closure and `arg` an
// argument that should be supplied to this closure. If the returned value is
// false, `ret` contains the value in the monad.
bool io_interpret(word_t x, word_t *ret, word_t *arg);
// IO interprets a function result stored in `juvix_result`.
#define IO_INTERPRET \
STACK_PUSH_ADDR(LABEL_ADDR(juvix_io_interpret_end)); \
juvix_io_interpret: \
while (1) { \
word_t juvix_io_ret, juvix_io_arg; \
SAVE_MEMORY_POINTERS; \
if (io_interpret(juvix_result, &juvix_io_ret, &juvix_io_arg)) { \
ASSERT(is_closure(juvix_io_ret)); \
ASSERT(get_closure_largs(juvix_io_ret) == 1); \
RESTORE_MEMORY_POINTERS; \
STACK_ENTER(2); \
STACK_PUSH(juvix_io_ret); \
juvix_result = juvix_io_arg; \
CALL(0, juvix_io_interpret, juvix_io_interpret_label_0); \
STACK_POP(juvix_io_ret); \
ASSIGN_CARGS(juvix_io_ret, \
{ CARG(juvix_closure_nargs) = juvix_result; }); \
CALL_CLOSURE(juvix_io_ret, juvix_io_interpret_label_1); \
STACK_LEAVE; \
} else { \
juvix_result = juvix_io_ret; \
RETURN_NS; \
} \
} \
juvix_io_interpret_end: \
io_flush();
#endif

49
runtime/src/juvix/limits.h Normal file
View File

@ -0,0 +1,49 @@
#ifndef JUVIX_LIMITS
#define JUVIX_LIMITS
#include <juvix/defs.h>
#define MAX_MEM_STRUCT_SIZE 64U
// The maximum number of words by which the global stack can be pushed or popped
// at once.
#define MAX_STACK_DELTA ((PAGE_SIZE - MAX_MEM_STRUCT_SIZE) / sizeof(word_t))
// The maximum number of words allocated in a single function.
#define MAX_FUNCTION_MEMORY ((PAGE_SIZE - MAX_MEM_STRUCT_SIZE) / sizeof(word_t))
// Maximum number of different UIDs (unique global object identifiers). Make
// sure this corresponds to the number of bits for the UID field in a header
// word (see juvix/object.h). Note that since UIDs start from 0, an UID cannot
// have the value MAX_UIDS.
#define MAX_UIDS 1048576U
// Maximum number of different constructors (globally).
#define MAX_CONSTR_TAGS MAX_UIDS
// Maximum number of special UIDs. Make sure this corresponds to the number of
// bits in the SUID field in a special header word (see: juvix/object.h).
#define MAX_SUIDS 4U
// Maximum number of fields. Make sure this corresponds to the number of bits
// for the NFIELDS field in a header word (see juvix/object.h).
#define MAX_FIELDS 255U
#define MAX_CONSTR_ARGS MAX_FIELDS
// Max number of fields minus the extra field in a closure.
#define MAX_FUNCTION_ARGS (MAX_FIELDS - 1)
#define MAX_CSTRING_LENGTH (MAX_FIELDS * sizeof(word_t) - 1)
#define MAX_LOCAL_VARS (PAGE_SIZE / 2 / sizeof(word_t))
// The maximum number of words that can be allocated on the heap by an
// invocation of the dispatch loop (CallClosures)
#define MAX_DISPATCH_ALLOC (MAX_FUNCTION_ARGS + CLOSURE_SKIP + 1)
/*****************************************/
/* Static asserts */
STATIC_ASSERT(MAX_FUNCTION_ARGS + MAX_LOCAL_VARS + 2 < MAX_STACK_DELTA);
#endif

19
runtime/src/juvix/mem.h Normal file
View File

@ -0,0 +1,19 @@
#ifndef JUVIX_MEM_H
#define JUVIX_MEM_H
#include <juvix/mem/alloc.h>
#include <juvix/mem/gens.h>
#include <juvix/mem/mem.h>
#include <juvix/mem/pages.h>
#include <juvix/mem/stack.h>
#define MEM_DECLS \
DECL_MEMORY_POINTER; \
DECL_STACK_POINTER
#define MEM_INIT \
alloc_init(); \
juvix_memory_pointer = alloc_memory_pointer(); \
juvix_stack_pointer = stack_init()
#endif

49
runtime/src/juvix/mem/alloc.c Normal file
View File

@ -0,0 +1,49 @@
#include <juvix/mem/alloc.h>
#include <juvix/mem/gens.h>
#include <juvix/opts.h>
generation_t *alloc_youngest_generation;
void alloc_init() {
gens_init();
alloc_youngest_generation = gen_alloc(NULL, opt_generation_min_pages);
}
void alloc_cleanup() {
generation_t *gen = alloc_youngest_generation;
while (gen != NULL) {
generation_t *prev = gen->prev;
gen_free(gen);
gen = prev;
}
}
void alloc_pages(bool can_gc) {
if (can_gc && alloc_youngest_generation->pages_max <=
alloc_youngest_generation->pages_num) {
// TODO: decide on GC collection here
alloc_youngest_generation =
gen_alloc(alloc_youngest_generation, opt_generation_min_pages);
}
++alloc_youngest_generation->pages_num;
alloc_youngest_generation->memory =
pool_alloc(alloc_youngest_generation->memory);
}
word_t *alloc(size_t n) {
ASSERT(alloc_youngest_generation->memory != NULL);
ASSERT(n > 0);
word_t *ptr;
ptr = alloc_youngest_generation->memory->free_begin;
if (unlikely(!is_same_page(ptr, ptr + n))) {
alloc_pages(false);
ptr = alloc_youngest_generation->memory->free_begin;
ASSERT(is_same_page(ptr, ptr + n));
}
alloc_youngest_generation->memory->free_begin =
(word_t *)alloc_youngest_generation->memory->free_begin + n;
ASSERT(alloc_youngest_generation->memory->free_begin <
alloc_youngest_generation->memory->free_end);
return ptr;
}

60
runtime/src/juvix/mem/alloc.h Normal file
View File

@ -0,0 +1,60 @@
#ifndef JUVIX_MEM_ALLOC_H
#define JUVIX_MEM_ALLOC_H
/*
This module provides an allocator for unstructured objects. When using the
allocated memory one needs to be mindful of C alignment and aliasing rules:
https://en.cppreference.com/w/c/language/object
https://stefansf.de/post/type-based-alias-analysis/
*/
#include <juvix/mem/gens.h>
#include <juvix/mem/pages.h>
#define DECL_MEMORY_POINTER register word_t *juvix_memory_pointer
extern generation_t *alloc_youngest_generation;
// Initialise the allocator module.
void alloc_init();
void alloc_cleanup();
// Allocate more memory pages.
void alloc_pages(bool can_gc);
static inline word_t *alloc_memory_pointer() {
return alloc_youngest_generation->memory->free_begin;
}
static inline void alloc_save_memory_pointer(word_t *ptr) {
alloc_youngest_generation->memory->free_begin = ptr;
}
#define SAVE_MEMORY_POINTERS alloc_save_memory_pointer(juvix_memory_pointer);
#define RESTORE_MEMORY_POINTERS juvix_memory_pointer = alloc_memory_pointer();
// Preallocate n words. `SAVE` and `RESTORE` should save and restore live local
// variables on the global stack (can lauch GC which needs access to these
// variables).
#define PREALLOC(n, SAVE, RESTORE) \
if (unlikely(is_next_page(juvix_memory_pointer, n))) { \
ASSERT(n < MAX_FUNCTION_MEMORY); \
SAVE; \
SAVE_MEMORY_POINTERS; \
alloc_pages(true); \
RESTORE_MEMORY_POINTERS; \
RESTORE; \
ASSERT(is_same_page(juvix_memory_pointer, juvix_memory_pointer + n)); \
}
// Allocate an n-word object and assign it to `ptr`.
#define ALLOC(ptr, n) \
ASSERT(is_same_page(juvix_memory_pointer, juvix_memory_pointer + n)); \
ptr = juvix_memory_pointer; \
juvix_memory_pointer += n;
// Allocate n words. Cannot call GC. This function doesn't require preallocation
// and cancels all preallocations made. One needs to save the memory pointers
// beforehand.
word_t *alloc(size_t n);
#endif

101
runtime/src/juvix/mem/gens.c Normal file
View File

@ -0,0 +1,101 @@
#include <juvix/mem/gens.h>
#include <juvix/mem/pages.h>
#define MAX_GENERATIONS 32
static generation_t gens_pool[MAX_GENERATIONS];
static generation_t *oldest_gen = NULL;
static generation_t *next_free_gen = NULL;
void gens_init() {
for (int i = 0; i < MAX_GENERATIONS - 1; ++i) {
gens_pool[i].next = gens_pool + i + 1;
}
gens_pool[MAX_GENERATIONS - 1].next = NULL;
next_free_gen = gens_pool;
}
pool_t *pool_alloc(pool_t *next) {
pool_t *pool = palloc(1);
pool->next = next;
pool->data = palign((uint8_t *)pool + sizeof(pool_t), sizeof(dword_t));
pool->free_begin = pool->data;
pool->free_end = (uint8_t *)pool + PAGE_SIZE;
ASSERT_ALIGNED(pool, PAGE_SIZE);
ASSERT_ALIGNED(pool->free_end, PAGE_SIZE);
return pool;
}
static void pool_free(pool_t *pool) {
while (pool != NULL) {
pool_t *next = pool->next;
pfree(pool, 1);
pool = next;
}
}
generation_t *gen_alloc(generation_t *prev, size_t pages_max) {
ASSERT(prev != next_free_gen);
if (next_free_gen == NULL) {
ASSERT(oldest_gen != NULL);
ASSERT(oldest_gen->next != NULL);
ASSERT(oldest_gen->next->prev == oldest_gen);
gen_merge(oldest_gen->next);
ASSERT(next_free_gen != NULL);
}
generation_t *gen = next_free_gen;
next_free_gen = gen->next;
gen->next = NULL;
gen->prev = prev;
if (prev != NULL) {
prev->next = gen;
}
gen->pages_max = pages_max;
gen->pages_num = 0;
gen->memory = pool_alloc(NULL);
if (prev == NULL) {
oldest_gen = gen;
}
return gen;
}
void gen_free(generation_t *gen) {
if (gen == oldest_gen) {
ASSERT(gen->prev == NULL);
oldest_gen = oldest_gen->next;
}
if (gen->prev != NULL) {
gen->prev->next = gen->next;
}
if (gen->next != NULL) {
gen->next->prev = gen->prev;
}
gen->next = next_free_gen;
next_free_gen = gen;
pool_free(gen->memory);
}
static void pool_prepend(pool_t **ppool, pool_t *pool) {
ASSERT(*ppool != NULL);
ASSERT(pool != NULL);
pool_t *next = *ppool;
*ppool = pool;
while (pool->next != NULL) {
pool = pool->next;
}
pool->next = next;
}
void gen_merge(generation_t *gen) {
ASSERT(gen->prev != NULL);
generation_t *prev = gen->prev;
prev->next = gen->next;
if (gen->next != NULL) {
gen->next->prev = prev;
}
pool_prepend(&prev->memory, gen->memory);
prev->pages_num += gen->pages_num;
gen->next = next_free_gen;
next_free_gen = gen;
}

42
runtime/src/juvix/mem/gens.h Normal file
View File

@ -0,0 +1,42 @@
#ifndef JUVIX_MEM_GENS_H
#define JUVIX_MEM_GENS_H
#include <juvix/defs.h>
#include <juvix/limits.h>
typedef struct Pool {
struct Pool *next;
void *data;
// the first free allocation unit in `data`
void *free_begin;
void *free_end;
} pool_t;
STATIC_ASSERT(sizeof(pool_t) <= MAX_MEM_STRUCT_SIZE);
typedef struct Generation {
// Pointer to the previous (older) generation.
struct Generation *prev;
// Pointer to the next (younger) generation.
struct Generation *next;
pool_t *memory;
// The total number of pages allocated in all pools.
size_t pages_num;
// The threshold number of pages before a new generation is created.
size_t pages_max;
} generation_t;
void gens_init();
pool_t *pool_alloc(pool_t *next);
// Allocate a new generation. May merge old generations if generation limit
// reached. If `prev` is NULL, then the newly allocated generation is assumed to
// be the oldest generation.
generation_t *gen_alloc(generation_t *prev, size_t pages_max);
void gen_free(generation_t *gen);
// Merge the given generation with the previous one.
void gen_merge(generation_t *gen);
#endif

302
runtime/src/juvix/mem/mem.c Normal file
View File

@ -0,0 +1,302 @@
#include <juvix/mem/mem.h>
#ifndef API_LIBC
void memcopy(word_t *restrict dest, const word_t *restrict src, size_t n) {
MEMCOPY(dest, src, n);
}
#endif
void memfill(word_t *dest, word_t val, size_t n) { MEMFILL(dest, val, n); }
#ifndef API_LIBC
#define BULK_MEMORY_THRESHOLD 32
// Copied from WASI libc sources, originally part of musl libc:
// https://github.com/WebAssembly/wasi-libc/blob/main/libc-top-half/musl/src/string/memset.c
void *memset(void *dest, int c, size_t n) {
#if defined(__wasm_bulk_memory__)
if (n > BULK_MEMORY_THRESHOLD) return __builtin_memset(dest, c, n);
#endif
unsigned char *s = dest;
size_t k;
/* Fill head and tail with minimal branching. Each
* conditional ensures that all the subsequently used
* offsets are well-defined and in the dest region. */
if (!n) return dest;
s[0] = c;
s[n - 1] = c;
if (n <= 2) return dest;
s[1] = c;
s[2] = c;
s[n - 2] = c;
s[n - 3] = c;
if (n <= 6) return dest;
s[3] = c;
s[n - 4] = c;
if (n <= 8) return dest;
/* Advance pointer to align it at a 4-byte boundary,
* and truncate n to a multiple of 4. The previous code
* already took care of any head/tail that get cut off
* by the alignment. */
k = -(uintptr_t)s & 3;
s += k;
n -= k;
n &= -4;
#ifdef __GNUC__
typedef uint32_t __attribute__((__may_alias__)) u32;
typedef uint64_t __attribute__((__may_alias__)) u64;
u32 c32 = ((u32)-1) / 255 * (unsigned char)c;
/* In preparation to copy 32 bytes at a time, aligned on
* an 8-byte bounary, fill head/tail up to 28 bytes each.
* As in the initial byte-based head/tail fill, each
* conditional below ensures that the subsequent offsets
* are valid (e.g. !(n<=24) implies n>=28). */
*(u32 *)(s + 0) = c32;
*(u32 *)(s + n - 4) = c32;
if (n <= 8) return dest;
*(u32 *)(s + 4) = c32;
*(u32 *)(s + 8) = c32;
*(u32 *)(s + n - 12) = c32;
*(u32 *)(s + n - 8) = c32;
if (n <= 24) return dest;
*(u32 *)(s + 12) = c32;
*(u32 *)(s + 16) = c32;
*(u32 *)(s + 20) = c32;
*(u32 *)(s + 24) = c32;
*(u32 *)(s + n - 28) = c32;
*(u32 *)(s + n - 24) = c32;
*(u32 *)(s + n - 20) = c32;
*(u32 *)(s + n - 16) = c32;
/* Align to a multiple of 8 so we can fill 64 bits at a time,
* and avoid writing the same bytes twice as much as is
* practical without introducing additional branching. */
k = 24 + ((uintptr_t)s & 4);
s += k;
n -= k;
/* If this loop is reached, 28 tail bytes have already been
* filled, so any remainder when n drops below 32 can be
* safely ignored. */
u64 c64 = c32 | ((u64)c32 << 32);
for (; n >= 32; n -= 32, s += 32) {
*(u64 *)(s + 0) = c64;
*(u64 *)(s + 8) = c64;
*(u64 *)(s + 16) = c64;
*(u64 *)(s + 24) = c64;
}
#else
/* Pure C fallback with no aliasing violations. */
for (; n; n--, s++) *s = c;
#endif
return dest;
}
// Copied from WASI libc sources, originally part of musl libc:
// https://github.com/WebAssembly/wasi-libc/blob/main/libc-top-half/musl/src/string/memcpy.c
void *memcpy(void *restrict dest, const void *restrict src, size_t n) {
#if defined(__wasm_bulk_memory__)
if (n > BULK_MEMORY_THRESHOLD) return __builtin_memcpy(dest, src, n);
#endif
unsigned char *d = dest;
const unsigned char *s = src;
#ifdef __GNUC__
#if __BYTE_ORDER == __LITTLE_ENDIAN
#define LS >>
#define RS <<
#else
#define LS <<
#define RS >>
#endif
typedef uint32_t __attribute__((__may_alias__)) u32;
uint32_t w, x;
for (; (uintptr_t)s % 4 && n; n--) *d++ = *s++;
if ((uintptr_t)d % 4 == 0) {
for (; n >= 16; s += 16, d += 16, n -= 16) {
*(u32 *)(d + 0) = *(u32 *)(s + 0);
*(u32 *)(d + 4) = *(u32 *)(s + 4);
*(u32 *)(d + 8) = *(u32 *)(s + 8);
*(u32 *)(d + 12) = *(u32 *)(s + 12);
}
if (n & 8) {
*(u32 *)(d + 0) = *(u32 *)(s + 0);
*(u32 *)(d + 4) = *(u32 *)(s + 4);
d += 8;
s += 8;
}
if (n & 4) {
*(u32 *)(d + 0) = *(u32 *)(s + 0);
d += 4;
s += 4;
}
if (n & 2) {
*d++ = *s++;
*d++ = *s++;
}
if (n & 1) {
*d = *s;
}
return dest;
}
if (n >= 32) switch ((uintptr_t)d % 4) {
case 1:
w = *(u32 *)s;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
n -= 3;
for (; n >= 17; s += 16, d += 16, n -= 16) {
x = *(u32 *)(s + 1);
*(u32 *)(d + 0) = (w LS 24) | (x RS 8);
w = *(u32 *)(s + 5);
*(u32 *)(d + 4) = (x LS 24) | (w RS 8);
x = *(u32 *)(s + 9);
*(u32 *)(d + 8) = (w LS 24) | (x RS 8);
w = *(u32 *)(s + 13);
*(u32 *)(d + 12) = (x LS 24) | (w RS 8);
}
break;
case 2:
w = *(u32 *)s;
*d++ = *s++;
*d++ = *s++;
n -= 2;
for (; n >= 18; s += 16, d += 16, n -= 16) {
x = *(u32 *)(s + 2);
*(u32 *)(d + 0) = (w LS 16) | (x RS 16);
w = *(u32 *)(s + 6);
*(u32 *)(d + 4) = (x LS 16) | (w RS 16);
x = *(u32 *)(s + 10);
*(u32 *)(d + 8) = (w LS 16) | (x RS 16);
w = *(u32 *)(s + 14);
*(u32 *)(d + 12) = (x LS 16) | (w RS 16);
}
break;
case 3:
w = *(u32 *)s;
*d++ = *s++;
n -= 1;
for (; n >= 19; s += 16, d += 16, n -= 16) {
x = *(u32 *)(s + 3);
*(u32 *)(d + 0) = (w LS 8) | (x RS 24);
w = *(u32 *)(s + 7);
*(u32 *)(d + 4) = (x LS 8) | (w RS 24);
x = *(u32 *)(s + 11);
*(u32 *)(d + 8) = (w LS 8) | (x RS 24);
w = *(u32 *)(s + 15);
*(u32 *)(d + 12) = (x LS 8) | (w RS 24);
}
break;
}
if (n & 16) {
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
}
if (n & 8) {
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
}
if (n & 4) {
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
*d++ = *s++;
}
if (n & 2) {
*d++ = *s++;
*d++ = *s++;
}
if (n & 1) {
*d = *s;
}
return dest;
#endif
for (; n; n--) *d++ = *s++;
return dest;
}
#ifdef __GNUC__
typedef __attribute__((__may_alias__)) size_t WT;
#define WS (sizeof(WT))
#endif
// Copied from WASI libc sources, originally part of musl libc:
// https://github.com/WebAssembly/wasi-libc/blob/main/libc-top-half/musl/src/string/memmove.c
void *memmove(void *dest, const void *src, size_t n) {
#if defined(__wasm_bulk_memory__)
if (n > BULK_MEMORY_THRESHOLD) return __builtin_memmove(dest, src, n);
#endif
char *d = dest;
const char *s = src;
if (d == s) return d;
if ((uintptr_t)s - (uintptr_t)d - n <= -2 * n) return memcpy(d, s, n);
if (d < s) {
#ifdef __GNUC__
if ((uintptr_t)s % WS == (uintptr_t)d % WS) {
while ((uintptr_t)d % WS) {
if (!n--) return dest;
*d++ = *s++;
}
for (; n >= WS; n -= WS, d += WS, s += WS) *(WT *)d = *(WT *)s;
}
#endif
for (; n; n--) *d++ = *s++;
} else {
#ifdef __GNUC__
if ((uintptr_t)s % WS == (uintptr_t)d % WS) {
while ((uintptr_t)(d + n) % WS) {
if (!n--) return dest;
d[n] = s[n];
}
while (n >= WS) n -= WS, *(WT *)(d + n) = *(WT *)(s + n);
}
#endif
while (n) n--, d[n] = s[n];
}
return dest;
}
#endif

44
runtime/src/juvix/mem/mem.h Normal file
View File

@ -0,0 +1,44 @@
#ifndef JUVIX_MEM_MEM_H
#define JUVIX_MEM_MEM_H
#include <juvix/defs.h>
#ifdef API_LIBC
#include <string.h>
#endif
// use MEMCOPY *only* if `N` is constant, `dest` and `src` are pointer variables
#define MEMCOPY(dest, src, N) \
do { \
for (size_t juvix_idx = 0; juvix_idx != N; ++juvix_idx) \
(dest)[juvix_idx] = (src)[juvix_idx]; \
} while (0)
// use MEMFILL *only* if `N` is constant and `dest` is a pointer variable
#define MEMFILL(dest, val, N) \
do { \
for (size_t juvix_idx = 0; juvix_idx != N; ++juvix_idx) \
(dest)[juvix_idx] = (val); \
} while (0)
#ifdef API_LIBC
// Copy `n` words from `src` to `dest`.
static inline void memcopy(word_t *restrict dest, const word_t *restrict src,
size_t n) {
memcpy(dest, src, n * sizeof(word_t));
}
#else
// Copy `n` words from `src` to `dest`.
void memcopy(word_t *restrict dest, const word_t *restrict src, size_t n);
#endif
// Fill `n` words at `dest` with `val`
void memfill(word_t *dest, word_t val, size_t n);
#ifndef API_LIBC
void *memset(void *dest, int c, size_t n);
void *memcpy(void *restrict dest, const void *restrict src, size_t n);
void *memmove(void *dest, const void *src, size_t n);
#endif
#endif

112
runtime/src/juvix/mem/pages.c Normal file
View File

@ -0,0 +1,112 @@
#include <juvix/mem/pages.h>
#include <juvix/opts.h>
size_t juvix_max_allocated_pages_num = 0;
size_t juvix_allocated_pages_num = 0;
#if defined(API_LIBC)
#include <stdlib.h>
void *palloc(size_t n) {
// `aligned_alloc` requires C11
void *ptr = aligned_alloc(PAGE_SIZE, n * PAGE_SIZE);
if (ptr == NULL) {
error_exit_msg("error: out of memory");
}
ASSERT_ALIGNED(ptr, PAGE_SIZE);
juvix_allocated_pages_num += n;
if (juvix_allocated_pages_num > juvix_max_allocated_pages_num) {
juvix_max_allocated_pages_num = juvix_allocated_pages_num;
}
return ptr;
}
void pfree(void *ptr, size_t n) {
juvix_allocated_pages_num -= n;
free(ptr);
}
#elif defined(ARCH_WASM32)
#define WASM_PAGE_SIZE_LOG2 16U
typedef struct Page {
struct Page *next;
size_t size; // the number of WASM pages
} page_t;
extern void __heap_base;
static void *heap_end = NULL;
static size_t heap_pages_num;
static page_t *free_page = NULL;
void *palloc(size_t n) {
ASSERT(n > 0);
n = n << (PAGE_SIZE_LOG2 - WASM_PAGE_SIZE_LOG2);
page_t *prev = NULL;
page_t *page = free_page;
while (page && page->size < n) {
prev = page;
page = page->next;
}
if (page) {
page_t *next;
if (page->size > n) {
next = (page_t *)((char *)page + (n << PAGE_SIZE_LOG2));
next->size = page->size - n;
next->next = page->next;
} else {
next = page->next;
}
if (prev) {
prev->next = next;
} else {
free_page = next;
}
ASSERT_ALIGNED(page, PAGE_SIZE);
juvix_allocated_pages_num += n;
if (juvix_allocated_pages_num > juvix_max_allocated_pages_num) {
juvix_max_allocated_pages_num = juvix_allocated_pages_num;
}
return page;
}
// Allocate `n` pages from WebAssembly
uintptr_t heap_size = __builtin_wasm_memory_size(0) << PAGE_SIZE_LOG2;
if (heap_end == NULL) {
// first-time allocation
heap_end = palign(&__heap_base, PAGE_SIZE);
heap_pages_num = (heap_size - (uintptr_t)heap_end) >> PAGE_SIZE_LOG2;
}
if (heap_size - (uintptr_t)heap_end < (n << PAGE_SIZE_LOG2)) {
size_t delta = max(opt_heap_grow_pages, max(n, heap_pages_num / 2));
ASSERT(delta != 0);
if (__builtin_wasm_memory_grow(0, delta) == (size_t)-1) {
error_exit_msg("error: out of memory");
}
heap_pages_num += delta;
}
void *ptr = heap_end;
heap_end = (char *)heap_end + (n << PAGE_SIZE_LOG2);
ASSERT_ALIGNED(ptr, PAGE_SIZE);
juvix_allocated_pages_num += n;
if (juvix_allocated_pages_num > juvix_max_allocated_pages_num) {
juvix_max_allocated_pages_num = juvix_allocated_pages_num;
}
return ptr;
}
void pfree(void *ptr, size_t n) {
n = n << (PAGE_SIZE_LOG2 - WASM_PAGE_SIZE_LOG2);
page_t *page = ptr;
page->size = n;
page->next = free_page;
free_page = page;
juvix_allocated_pages_num -= n;
}
#else
#error "Unsupported configuration"
#endif

31
runtime/src/juvix/mem/pages.h Normal file
View File

@ -0,0 +1,31 @@
#ifndef JUVIX_MEM_PAGES_H
#define JUVIX_MEM_PAGES_H
#include <juvix/defs.h>
extern size_t juvix_max_allocated_pages_num;
extern size_t juvix_allocated_pages_num;
// Allocate a continuous block of memory of `n` pages (`n * PAGE_SIZE` bytes).
// The memory is PAGE_SIZE-aligned.
void *palloc(size_t n);
// Free a previously allocated block of `n` pages.
void pfree(void *ptr, size_t n);
static inline bool is_same_page(void *p1, void *p2) {
return ((((uintptr_t)p1) ^ ((uintptr_t)p2)) & ~(uintptr_t)PAGE_MASK) == 0;
}
static inline bool is_page_start(void *p) {
return (((uintptr_t)(p)) & PAGE_MASK) == 0;
}
static inline bool is_next_page(void *p, uint n) {
return ((uintptr_t)p & PAGE_MASK) + n * sizeof(word_t) >= PAGE_SIZE;
}
static inline void *page_start(void *p) {
return (void *)((uintptr_t)p & ~(uintptr_t)PAGE_MASK);
}
#endif

28
runtime/src/juvix/mem/stack.c Normal file
View File

@ -0,0 +1,28 @@
#include <juvix/mem/pages.h>
#include <juvix/mem/stack.h>
#define STACK_PREV(seg) *(word_t **)(seg + PAGE_SIZE / sizeof(word_t) - 1)
word_t *stack_init() {
word_t *seg = palloc(1);
STACK_PREV(seg) = NULL;
return seg + 1;
}
word_t *stack_grow(word_t *sp) {
word_t *seg = palloc(1);
STACK_PREV(seg) = sp;
return seg;
}
word_t *stack_shrink(word_t *sp) {
ASSERT(is_page_start(sp));
ASSERT(page_start(sp) == sp);
word_t *seg = sp;
ASSERT(seg != NULL);
word_t *prev = STACK_PREV(seg);
ASSERT(prev != NULL);
pfree(seg, 1);
return prev;
}

34
runtime/src/juvix/mem/stack.h Normal file
View File

@ -0,0 +1,34 @@
#ifndef JUVIX_MEM_STACK_H
#define JUVIX_MEM_STACK_H
#include <juvix/defs.h>
#include <juvix/limits.h>
#define DECL_STACK_POINTER register word_t *juvix_stack_pointer
// The following functions return the stack pointer
word_t *stack_init();
word_t *stack_grow(word_t *sp);
word_t *stack_shrink(word_t *sp);
#define STACK_ENTER(n) \
do { \
ASSERT(n <= MAX_STACK_DELTA); \
if (unlikely(is_next_page(juvix_stack_pointer, n))) { \
juvix_stack_pointer = stack_grow(juvix_stack_pointer); \
} \
} while (0)
#define STACK_LEAVE \
do { \
if (unlikely(is_page_start(juvix_stack_pointer))) { \
juvix_stack_pointer = stack_shrink(juvix_stack_pointer); \
} \
} while (0)
#define STACK_PUSH(val) (*juvix_stack_pointer++ = (word_t)(val))
#define STACK_POP(var) (var = *--juvix_stack_pointer)
#define STACK_TOP (*(juvix_stack_pointer - 1))
#define STACK_POPT --juvix_stack_pointer
#endif

12
runtime/src/juvix/object.h Normal file
View File

@ -0,0 +1,12 @@
#ifndef JUVIX_OBJECT_H
#define JUVIX_OBJECT_H
#include <juvix/object/boolean.h>
#include <juvix/object/closure.h>
#include <juvix/object/constr.h>
#include <juvix/object/cstring.h>
#include <juvix/object/equality.h>
#include <juvix/object/integer.h>
#include <juvix/object/print.h>
#endif

12
runtime/src/juvix/object/boolean.h Normal file
View File

@ -0,0 +1,12 @@
#ifndef JUVIX_OBJECT_BOOLEAN_H
#define JUVIX_OBJECT_BOOLEAN_H
#include <juvix/object/object.h>
#define BOOL_TRUE MAKE_HEADER(UID_TRUE, 0)
#define BOOL_FALSE MAKE_HEADER(UID_FALSE, 0)
static inline word_t make_bool(bool b) { return b ? BOOL_TRUE : BOOL_FALSE; }
static inline bool is_true(word_t x) { return x == BOOL_TRUE; }
#endif

15
runtime/src/juvix/object/closure.c Normal file
View File

@ -0,0 +1,15 @@
#include <juvix/object/closure.h>
word_t alloc_closure(uint fuid, label_addr_t addr, uint nargs, uint largs) {
word_t var = (word_t)alloc(nargs + CLOSURE_SKIP + 1);
INIT_CLOSURE(var, fuid, (word_t)addr, nargs, largs);
return var;
}
word_t extend_closure(word_t closure, uint n) {
size_t nfields = get_nfields(closure) + n;
word_t var = (word_t)alloc(nfields + 1);
COPY_EXTEND_CLOSURE(var, closure, n, nfields);
return var;
}

123
runtime/src/juvix/object/closure.h Normal file
View File

@ -0,0 +1,123 @@
#ifndef JUVIX_OBJECT_CLOSURE_H
#define JUVIX_OBJECT_CLOSURE_H
#include <juvix/mem/alloc.h>
#include <juvix/mem/mem.h>
#include <juvix/object/object.h>
#ifdef DEBUG
#define CLOSURE_SKIP 2
#else
#define CLOSURE_SKIP 1
#endif
#define CLOSURE_HEAD_SIZE (CLOSURE_SKIP + 1)
// The number of arguments stored in the closure.
static inline size_t get_closure_nargs(word_t cl) {
return get_nfields(cl) - CLOSURE_SKIP;
}
// The number of arguments remaining for a call to the
// function.
static inline word_t get_closure_largs(word_t x) { return get_reserved(x); }
#ifdef DEBUG
static inline size_t get_closure_fuid(word_t cl) { return FIELD(cl, 1); }
#endif
static inline label_addr_t get_closure_addr(word_t cl) {
return (label_addr_t)FIELD(cl, CLOSURE_SKIP);
}
static inline word_t *get_closure_args(word_t cl) {
return (word_t *)cl + CLOSURE_HEAD_SIZE;
}
#define CLOSURE_ARG(var, n) FIELD(var, (n) + CLOSURE_HEAD_SIZE)
#define INIT_CLOSURE0(var, addr, nargs, largs) \
FIELD(var, 0) = make_special_header(SUID_CLOSURE, nargs + CLOSURE_SKIP, \
CLOSURE_SKIP, largs);
#ifdef DEBUG
#define INIT_CLOSURE(var, fuid, addr, nargs, largs) \
do { \
INIT_CLOSURE0(var, addr, nargs, largs); \
FIELD(var, 1) = fuid; \
FIELD(var, 2) = (word_t)addr; \
} while (0)
#else
#define INIT_CLOSURE(var, fuid, addr, nargs, largs) \
do { \
INIT_CLOSURE0(var, addr, nargs, largs); \
FIELD(var, 1) = (word_t)addr; \
} while (0)
#endif
#define ALLOC_CLOSURE(var, fuid, addr, nargs, largs) \
do { \
word_t *tmp; \
ALLOC(tmp, (nargs) + CLOSURE_SKIP + 1); \
var = (word_t)tmp; \
INIT_CLOSURE(var, fuid, addr, nargs, largs); \
} while (0)
#define COPY_EXTEND_CLOSURE(dest, src, n, nfields) \
do { \
ASSERT(n < get_closure_largs(src)); \
FIELD(dest, 0) = make_special_header( \
SUID_CLOSURE, nfields, CLOSURE_SKIP, get_closure_largs(src) - n); \
memcopy((word_t *)(dest) + 1, (word_t *)(src) + 1, nfields - n); \
} while (0)
/*
EXTEND_CLOSURE(dest, src, n, {
CLOSURE_ARG(dest, juvix_closure_nargs) = arg1;
...
CLOSURE_ARG(dest, juvix_closure_nargs + n - 1) = argn;
}
*/
#define EXTEND_CLOSURE(dest, src, n, CODE) \
do { \
{ \
void *tmp; \
size_t nfields = get_nfields(src) + n; \
ALLOC(tmp, nfields + 1); \
dest = (word_t)tmp; \
COPY_EXTEND_CLOSURE(dest, src, n, nfields); \
} \
size_t juvix_closure_nargs = get_closure_nargs(src); \
CODE; \
} while (0)
#define DECL_ZEROARG_CLOSURE(name, fuid, largs) \
word_t juvix_zeroarg_closure_data_##name[1 + CLOSURE_SKIP]; \
word_t juvix_zeroarg_closure_##name = \
(word_t)&juvix_zeroarg_closure_data_##name; \
INIT_CLOSURE(juvix_zeroarg_closure_##name, fuid, \
LABEL_ADDR(juvix_closure_##name), 0, largs);
#define CURRY_CLOSURE(var, closure, largs) \
do { \
ALLOC_CLOSURE(var, 0, LABEL_ADDR(juvix_curry_##largs), 1, largs); \
CLOSURE_ARG(var, 0) = closure; \
} while (0)
#define CURRY_CLOSURE_ALLOC_SIZE (CLOSURE_HEAD_SIZE + 1)
#define DECL_CURRY(largs) \
juvix_curry_##largs : STACK_ENTER(DISPATCH_STACK_SIZE + (largs)); \
for (int i = (largs); i > 0; --i) { \
STACK_PUSH(CARG(i)); \
} \
TAIL_CALL_CLOSURES(CARG(0), largs);
// Memory pointers (see alloc.h) need to be saved before calling the following
// functions (they call alloc).
word_t alloc_closure(uint fuid, label_addr_t addr, uint nargs, uint largs);
word_t extend_closure(word_t closure, uint n);
#endif

54
runtime/src/juvix/object/constr.h Normal file
View File

@ -0,0 +1,54 @@
#ifndef JUVIX_OBJECT_CONSTR_H
#define JUVIX_OBJECT_CONSTR_H
#include <juvix/mem/alloc.h>
#include <juvix/object/object.h>
#define ALLOC_CONSTR_UNBOXED(var, uid) \
do { \
var = make_header(uid, 0); \
} while (0)
#define ALLOC_CONSTR_BOXED(var, uid, nfields) \
do { \
void *tmp; \
ALLOC(tmp, (nfields) + 1); \
var = (word_t)tmp; \
FIELD(var, 0) = make_header(uid, nfields); \
} while (0)
#define ALLOC_CONSTR_BOXED_TAG(var, uid) \
do { \
void *tmp; \
ALLOC(tmp, 2); \
var = (word_t)tmp; \
FIELD(var, 0) = make_header(uid, 1); \
FIELD(var, 1) = 1; \
} while (0)
#define ALLOC_CONSTR_PAIR(var) \
do { \
void *tmp; \
ALLOC(tmp, 2); \
var = (word_t)tmp; \
} while (0)
#define FST(var) FIELD(var, 0)
#define SND(var) FIELD(var, 1)
#define CONSTR_ARG(var, n) FIELD(var, (n) + 1)
static inline size_t get_constr_nargs(word_t x) { return get_nfields(x); }
static inline word_t *get_constr_args(word_t x) { return (word_t *)x + 1; }
// Memory pointers (see alloc.h) need to be saved before calling the following
// functions (calls alloc).
static inline word_t alloc_constr(uint uid, size_t nfields) {
word_t var = (word_t)alloc(nfields + 1);
FIELD(var, 0) = make_header(uid, nfields);
return var;
}
static inline word_t alloc_pair() { return (word_t)alloc(2); }
#endif

29
runtime/src/juvix/object/cstring.c Normal file
View File

@ -0,0 +1,29 @@
#include <juvix/object/cstring.h>
#ifndef API_LIBC
size_t strlen(const char *str) {
const char *str0 = str;
while (*str) {
++str;
}
return str - str0;
}
char *strcpy(char *restrict dest, const char *restrict src) {
char *dest0 = dest;
while (*src) {
*dest = *src;
++dest;
++src;
}
return dest0;
}
#endif
word_t alloc_cstring(const char *str) {
size_t n = (strlen(str) + sizeof(word_t)) / sizeof(word_t);
word_t var = (word_t)alloc(n + 1);
INIT_CSTRING(var, str, n);
return var;
}

39
runtime/src/juvix/object/cstring.h Normal file
View File

@ -0,0 +1,39 @@
#ifndef JUVIX_OBJECT_CSTRING_H
#define JUVIX_OBJECT_CSTRING_H
#include <juvix/mem/alloc.h>
#include <juvix/mem/mem.h>
#include <juvix/object/object.h>
#ifdef API_LIBC
#include <string.h>
#else
size_t strlen(const char *str);
char *strcpy(char *restrict dest, const char *restrict src);
#endif
static inline char *get_cstring(word_t x) {
ASSERT(is_cstring(x));
return (char *)x + sizeof(word_t);
}
#define INIT_CSTRING(var, str, nfields) \
FIELD(var, 0) = make_special_header(SUID_CSTRING, nfields, SKIP_ALL, 0); \
FIELD(var, nfields) = 0; \
strcpy((char *)(var) + sizeof(word_t), str);
#define ALLOC_CSTRING(var, str) \
do { \
size_t juvix_nfields = \
(strlen(str) + sizeof(word_t)) / sizeof(word_t); \
void *tmp; \
ALLOC(tmp, juvix_nfields + 1); \
var = (word_t)tmp; \
INIT_CSTRING(var, str, juvix_nfields); \
} while (0)
// Memory pointers (see alloc.h) need to be saved before calling this
// function.
word_t alloc_cstring(const char *str);
#endif

24
runtime/src/juvix/object/equality.c Normal file
View File

@ -0,0 +1,24 @@
#include <juvix/object/constr.h>
#include <juvix/object/equality.h>
bool juvix_constr_equal(word_t x, word_t y) {
ASSERT(!is_ptr(x));
ASSERT(!is_ptr(y));
word_t hx = get_header(x);
word_t hy = get_header(y);
if (hx != hy) {
return false;
}
if (is_header(hx)) {
size_t n = GET_NFIELDS(hx);
for (size_t i = 1; i <= n; ++i) {
if (!juvix_equal(FIELD(x, i), FIELD(y, i))) {
return false;
}
}
return true;
} else {
return juvix_equal(FST(x), FST(y)) && juvix_equal(SND(x), SND(y));
}
}

12
runtime/src/juvix/object/equality.h Normal file
View File

@ -0,0 +1,12 @@
#ifndef JUVIX_OBJECT_EQUALITY_H
#define JUVIX_OBJECT_EQUALITY_H
#include <juvix/object/object.h>
bool juvix_constr_equal(word_t x, word_t y);
static inline bool juvix_equal(word_t x, word_t y) {
return x == y || (is_ptr(x) && is_ptr(y) && juvix_constr_equal(x, y));
}
#endif

34
runtime/src/juvix/object/integer.h Normal file
View File

@ -0,0 +1,34 @@
#ifndef JUVIX_OBJECT_INTEGER_H
#define JUVIX_OBJECT_INTEGER_H
/*
This module provides an implementation of Juvix integers.
Assumption: Signed machine integers are represented in two's complement.
*/
#include <juvix/object/boolean.h>
#include <juvix/object/object.h>
static inline word_t make_smallint(word_t x) { return make_unboxed(x); }
static inline word_t smallint_add(word_t x, word_t y) { return x - 1 + y; }
static inline word_t smallint_sub(word_t x, word_t y) { return x - y + 1; }
static inline word_t smallint_mul(word_t x, word_t y) {
return make_smallint(get_unboxed_int(x) * get_unboxed_int(y));
}
static inline word_t smallint_div(word_t x, word_t y) {
return make_smallint(get_unboxed_int(x) / get_unboxed_int(y));
}
static inline word_t smallint_mod(word_t x, word_t y) {
return make_smallint(get_unboxed_int(x) % get_unboxed_int(y));
}
static inline word_t smallint_lt(word_t x, word_t y) {
return make_bool(get_unboxed_int(x) < get_unboxed_int(y));
}
static inline word_t smallint_le(word_t x, word_t y) {
return make_bool(get_unboxed_int(x) <= get_unboxed_int(y));
}
#endif

187
runtime/src/juvix/object/object.h Normal file
View File

@ -0,0 +1,187 @@
#ifndef JUVIX_OBJECT_OBJECT_H
#define JUVIX_OBJECT_OBJECT_H
#include <juvix/defs.h>
#include <juvix/limits.h>
// The least significant two bits encode object kind
#define KIND_MASK 3
#define GET_KIND(x) ((word_t)(x)&KIND_MASK)
#define KIND_PTR 0
#define KIND_UNBOXED0 1
#define KIND_UNBOXED1 3
#define KIND_HEADER 2
#define KIND3_MASK 7
#define GET_KIND3(x) ((word_t)(x)&KIND3_MASK)
static inline bool is_unboxed(word_t x) { return x & 1; }
static inline bool is_ptr(word_t x) { return GET_KIND(x) == KIND_PTR; }
static inline bool is_header(word_t x) { return GET_KIND(x) == KIND_HEADER; }
/*
An ordinary header word consists of (field:bits in lower 32 bits from most to
least significant):
|NFIELDS:8|UID:20|MARK:1|SPECIAL:1|KIND:2|
- NFIELDS specifies the number of fields following the header.
- UID contains a unique object identifier.
- MARK is a mark bit used by the GC. It is always 0 when not in GC collection
phase.
- SPECIAL is set to 0.
- KIND specifies the object kind. Contains the KIND_HEADER bit-pattern.
A special header word consists of:
|NFIELDS:8|RESERVED:16|SKIP:2|SUID:2|MARK:1|SPECIAL:1|KIND:2|
- NFIELDS specifies the number of fields following the header.
- RESERVED contains bits reserved for the special object (it depends on the SUID
what they signify)
- SKIP indicates how may fields directly following the header contain
non-garbage-collected raw bit patterns. SKIP = SKIP_ALL indicates that all
fields contain raw bit patterns. SKIP < SKIP_ALL indicates the actual number
of non-garbage collected raw bit-pattern fields.
- SUID contains the special object identifier.
- MARK is a mark bit used by the GC. It is always 0 when not in GC collection
phase.
- SPECIAL is set to 1.
- KIND specifies the object kind. Contains the KIND_HEADER bit-pattern.
*/
#define MARK_MASK ((word_t)0x10)
static inline bool is_marked(word_t x) { return x & MARK_MASK; }
static inline word_t set_mark(word_t x) { return x | MARK_MASK; }
static inline word_t clear_mark(word_t x) { return x & ~MARK_MASK; }
#define UID_MASK ((word_t)0x00FFFFF0)
#define UID_SHIFT 4U
#define GET_UID(x) (((word_t)(x)&UID_MASK) >> UID_SHIFT)
#define NFIELDS_MASK 0xFF000000
#define NFIELDS_SHIFT 24U
#define GET_NFIELDS(x) ((word_t)(x) >> NFIELDS_SHIFT)
#define MAKE_HEADER(uid, nfields) \
(((nfields) << NFIELDS_SHIFT) | ((uid) << UID_SHIFT) | KIND_HEADER)
static inline word_t make_header(word_t uid, word_t nfields) {
ASSERT(uid < MAX_UIDS);
ASSERT(nfields <= MAX_FIELDS);
return MAKE_HEADER(uid, nfields);
}
#define MAKE_UNBOXED(x) (((x) << 1U) | 1U)
static inline word_t make_unboxed(word_t x) { return MAKE_UNBOXED(x); }
static inline word_t get_unboxed(word_t x) { return x >> 1U; }
static inline int_t get_unboxed_int(word_t x) { return (int_t)x >> 1; }
#define FIELD(var, n) (((word_t *)(var))[n])
static inline word_t get_header(word_t ptr) { return FIELD(ptr, 0); }
static inline bool has_header(word_t ptr) { return is_header(get_header(ptr)); }
static inline size_t get_nfields(word_t ptr) {
return GET_NFIELDS(FIELD(ptr, 0));
}
static inline word_t get_uid(word_t ptr) { return GET_UID(FIELD(ptr, 0)); }
#define SPECIAL_MASK ((word_t)0x4)
#define SPECIAL_HEADER_MASK ((word_t)0x7)
#define KIND_SPECIAL_HEADER (SPECIAL_MASK | KIND_HEADER)
static inline bool is_special(word_t x) { return x & SPECIAL_MASK; }
static inline bool is_special_header(word_t x) {
return (x & SPECIAL_HEADER_MASK) == KIND_SPECIAL_HEADER;
}
#define SUID_MASK ((word_t)0x30)
#define SUID_SHIFT 4U
#define GET_SUID(x) (((word_t)(x)&SUID_MASK) >> SUID_SHIFT)
#define SKIP_MASK ((word_t)0xC0)
#define SKIP_SHIFT 6U
#define GET_SKIP(x) (((word_t)(x)&SKIP_MASK) >> SKIP_SHIFT)
#define SKIP_ALL 3U
#define RESERVED_MASK 0x00FFFF00
#define RESERVED_SHIFT 8U
#define GET_RESERVED(x) (((word_t)(x)&RESERVED_MASK) >> RESERVED_SHIFT)
static inline word_t make_special_header(word_t suid, word_t nfields,
word_t skip, word_t reserved) {
ASSERT(suid < MAX_SUIDS);
ASSERT(nfields <= MAX_FIELDS);
ASSERT(skip <= SKIP_ALL);
ASSERT(reserved <= (RESERVED_MASK >> RESERVED_SHIFT));
return (nfields << NFIELDS_SHIFT) | (reserved << RESERVED_SHIFT) |
(skip << SKIP_SHIFT) | (suid << SUID_SHIFT) | KIND_SPECIAL_HEADER;
}
static inline bool has_special_header(word_t ptr) {
return is_special_header(get_header(ptr));
}
static inline size_t get_skip(word_t ptr) { return GET_SKIP(FIELD(ptr, 0)); }
static inline size_t get_reserved(word_t ptr) {
return GET_RESERVED(FIELD(ptr, 0));
}
static inline word_t get_suid(word_t ptr) { return GET_SUID(FIELD(ptr, 0)); }
/*************************************************/
/* Builtin constructor UIDs */
#define UID_FALSE 0
#define UID_TRUE 1
#define UID_UNIT 2
#define UID_VOID 3
#define UID_RETURN 4
#define UID_BIND 5
#define UID_WRITE 6
#define UID_READLN 7
#define BUILTIN_UIDS_NUM 8
#define FIRST_USER_UID BUILTIN_UIDS_NUM
#define BUILTIN_UIDS_INFO \
{"false"}, {"true"}, {"unit"}, {"void"}, {"return"}, {"bind"}, {"write"}, \
{ \
"readln" \
}
/*************************************************/
/* Special UIDs */
// A closure has a non-garbage-collected function
// address field immediately after the header. The other fields are closure
// arguments. The RESERVED bits indicate the number of arguments remaining. In
// debug mode, there is one more non-garbage-collected field after the header
// which contains the FUID (function id).
#define SUID_CLOSURE 0
// The header is followed by a zero-terminated string. NFIELDS contains the
// length of the string rounded up to a multiple of word size.
#define SUID_CSTRING 1
static inline bool is_closure(word_t x) {
return is_ptr(x) && has_special_header(x) && get_suid(x) == SUID_CLOSURE;
}
static inline bool is_cstring(word_t x) {
return is_ptr(x) && has_special_header(x) && get_suid(x) == SUID_CSTRING;
}
#define OBJ_UNIT make_header(UID_UNIT, 0)
#define OBJ_VOID make_header(UID_VOID, 0)
#endif

230
runtime/src/juvix/object/print.c Normal file
View File

@ -0,0 +1,230 @@
#include <juvix/info.h>
#include <juvix/mem/pages.h>
#include <juvix/object/closure.h>
#include <juvix/object/constr.h>
#include <juvix/object/cstring.h>
#include <juvix/object/object.h>
#include <juvix/object/print.h>
static size_t print_long(char *buf, size_t n, long_t x) {
ASSERT(n >= 1);
if (x == 0) {
*buf++ = '0';
return 1;
}
size_t sign = 0;
if (x < 0) {
x = -x;
*buf++ = '-';
--n;
sign = 1;
}
char *buf0 = buf;
while (x != 0 && n > 0) {
long_t y = x % 10;
*buf++ = '0' + y;
x = x / 10;
--n;
}
size_t k = buf - buf0;
for (size_t i = 0; i < k / 2; ++i) {
char c = buf0[i];
buf0[i] = *(buf - i - 1);
*(buf - i - 1) = c;
}
return k + sign;
}
#define PUTC(c) \
do { \
*buf++ = c; \
if (--n == 0) return buf - buf0; \
} while (0)
static size_t print_object(bool is_top, char *buf, size_t n, word_t x);
static size_t print_args(bool is_top, char *restrict buf, size_t n,
const char *restrict str, word_t *args, size_t nargs) {
ASSERT(n >= 1);
char *buf0 = buf;
if (!is_top && nargs > 0) {
PUTC('(');
}
while (*str) {
PUTC(*str++);
}
for (size_t i = 0; i < nargs; ++i) {
PUTC(' ');
size_t delta = print_object(false, buf, n, args[i]);
buf += delta;
n -= delta;
if (n == 0) {
return buf - buf0;
}
}
if (!is_top && nargs > 0) {
PUTC(')');
}
return buf - buf0;
}
static size_t print_object(bool is_top, char *buf, size_t n, word_t x) {
ASSERT(n >= 1);
switch (GET_KIND(x)) {
case KIND_UNBOXED0:
case KIND_UNBOXED1:
return print_long(buf, n, get_unboxed_int(x));
case KIND_PTR: {
char *buf0 = buf;
word_t h = get_header(x);
size_t delta;
if (is_header(h)) {
if (is_special(h)) {
switch (GET_SUID(h)) {
case SUID_CLOSURE: {
size_t nargs = get_closure_nargs(x);
#ifdef DEBUG
const char *str =
get_closure_fuid(x) < juvix_functions_num
? juvix_function_info[get_closure_fuid(x)]
.name
: "<closure>";
#else
const char *str = "<closure>";
#endif
buf += print_args(is_top, buf, n, str,
get_closure_args(x), nargs);
break;
}
case SUID_CSTRING: {
const char *str = get_cstring(x);
PUTC('"');
while (*str) {
switch (*str) {
case '\a':
PUTC('\\');
PUTC('a');
++str;
break;
case '\b':
PUTC('\\');
PUTC('b');
++str;
break;
case '\f':
PUTC('\\');
PUTC('f');
++str;
break;
case '\n':
PUTC('\\');
PUTC('n');
++str;
break;
case '\r':
PUTC('\\');
PUTC('r');
++str;
break;
case '\t':
PUTC('\\');
PUTC('t');
++str;
break;
case '\v':
PUTC('\\');
PUTC('v');
++str;
break;
case '\\':
PUTC('\\');
PUTC('\\');
++str;
break;
case '"':
PUTC('\\');
PUTC('"');
++str;
break;
default:
PUTC(*str++);
}
}
PUTC('"');
break;
}
}
} else {
size_t nargs = GET_NFIELDS(h);
ASSERT(GET_UID(h) < juvix_constrs_num);
const char *str = juvix_constr_info[GET_UID(h)].name;
buf += print_args(is_top, buf, n, str, get_constr_args(x),
nargs);
}
} else {
PUTC('(');
delta = print_object(true, buf, n, FST(x));
n -= delta;
buf += delta;
if (n == 0) {
return buf - buf0;
}
PUTC(',');
PUTC(' ');
delta = print_object(true, buf, n, SND(x));
n -= delta;
buf += delta;
if (n == 0) {
return buf - buf0;
}
PUTC(')');
}
return buf - buf0;
}
case KIND_HEADER:
ASSERT(is_header(x));
char *buf0 = buf;
ASSERT(GET_UID(x) < juvix_constrs_num);
const char *str = juvix_constr_info[GET_UID(x)].name;
while (*str) {
PUTC(*str++);
}
return buf - buf0;
default:
UNREACHABLE;
}
}
#undef PUTC
size_t print_to_buf(char *buf, size_t n, word_t x) {
ASSERT(n >= 1);
size_t k = print_object(true, buf, n, x);
if (k < n) {
buf[k] = 0;
}
return k;
}
char *print(word_t x) {
// TODO: replace this with malloc when we have it for all APIs
char *buf = palloc(1);
size_t n = print_to_buf(buf, PAGE_SIZE, x);
if (n == PAGE_SIZE) {
buf[PAGE_SIZE - 1] = 0;
buf[PAGE_SIZE - 2] = '.';
buf[PAGE_SIZE - 3] = '.';
buf[PAGE_SIZE - 4] = '.';
}
return buf;
}
void free_strbuf(char *buf) { pfree(buf, 1); }
// Prints using print_msg
void printout(word_t x) {
char *buf = print(x);
print_msg(buf);
free_strbuf(buf);
}

17
runtime/src/juvix/object/print.h Normal file
View File

@ -0,0 +1,17 @@
#ifndef JUVIX_OBJECT_PRINT_H
#define JUVIX_OBJECT_PRINT_H
#include <juvix/defs.h>
// Returns the number of characters printed. If `buf` was big enough then the
// return value is strictly less than `n` and the string in `buf` is
// 0-terminated. Otherwise, the return value is equal to `n`.
size_t print_to_buf(char *buf, size_t n, word_t x);
// The returned pointer should be freed with `free_strbuf`.
char *print(word_t x);
void free_strbuf(char *buf);
// Prints using print_msg
void printout(word_t x);
#endif

5
runtime/src/juvix/opts.c Normal file
View File

@ -0,0 +1,5 @@
#include <juvix/opts.h>
size_t opt_generation_min_pages = OPT_GENERATION_MIN_PAGES;
size_t opt_heap_grow_pages = OPT_HEAP_GROW_PAGES;

23
runtime/src/juvix/opts.h Normal file
View File

@ -0,0 +1,23 @@
#ifndef JUVIX_OPTS_H
#define JUVIX_OPTS_H
#include <juvix/defs.h>
// How many pages should be requested from the OS at once when we've run out of
// memory?
extern size_t opt_heap_grow_pages;
// The minimum number of pages in a generation.
extern size_t opt_generation_min_pages;
/*******************************/
/* Default values */
#ifndef OPT_HEAP_GROW_PAGES
#define OPT_HEAP_GROW_PAGES 24
#endif
#ifndef OPT_GENERATION_MIN_PAGES
#define OPT_GENERATION_MIN_PAGES 4
#endif
#endif

3
src/Juvix/Compiler/Asm/Language.hs
View File

@ -186,7 +186,8 @@ data InstrCall = InstrCall
}
newtype InstrCallClosures = InstrCallClosures
{ -- | The number of arguments supplied to the call.
{ -- | The number of arguments supplied to the call. This does not include the
-- called closure on top of the stack.
_callClosuresArgsNum :: Int
}

4
test/Main.hs
View File

@ -7,6 +7,7 @@ import Base
import Core qualified
import Parsing qualified
import Reachability qualified
import Runtime qualified
import Scope qualified
import Termination qualified
import Typecheck qualified
@ -17,7 +18,8 @@ slowTests =
"Juvix slow tests"
[ BackendC.allTests,
Core.allTests,
Asm.allTests
Asm.allTests,
Runtime.allTests
]
fastTests :: TestTree

7
test/Runtime.hs Normal file
View File

@ -0,0 +1,7 @@
module Runtime where
import Base
import Runtime.Positive qualified as P
allTests :: TestTree
allTests = testGroup "Runtime tests" [P.allTests]

109
test/Runtime/Base.hs Normal file
View File

@ -0,0 +1,109 @@
module Runtime.Base where
import Base
import Data.FileEmbed
import Data.Text.IO qualified as TIO
import System.IO.Extra (withTempDir)
import System.Process qualified as P
clangCompile ::
(FilePath -> FilePath -> [String]) ->
FilePath ->
FilePath ->
(FilePath -> IO Text) ->
(String -> IO ()) ->
IO Text
clangCompile mkClangArgs inputFile outputFile execute step =
withTempDir
( \dirPath -> do
let outputFile' = dirPath </> outputFile
step "C compilation"
P.callProcess
"clang"
(mkClangArgs outputFile' inputFile)
step "Execution"
execute outputFile'
)
clangAssertion :: FilePath -> FilePath -> Text -> ((String -> IO ()) -> Assertion)
clangAssertion inputFile expectedFile stdinText step = do
step "Check clang and wasmer are on path"
assertCmdExists "clang"
assertCmdExists "wasmer"
step "Lookup WASI_SYSROOT_PATH"
sysrootPath <-
assertEnvVar
"Env var WASI_SYSROOT_PATH missing. Set to the location of the wasi-clib sysroot"
"WASI_SYSROOT_PATH"
expected <- TIO.readFile expectedFile
let executeWasm :: FilePath -> IO Text
executeWasm outputFile = pack <$> P.readProcess "wasmer" [outputFile] (unpack stdinText)
let executeNative :: FilePath -> IO Text
executeNative outputFile = pack <$> P.readProcess outputFile [] (unpack stdinText)
step "Compile C to WASM32-WASI"
actualWasm <- clangCompile (wasiArgs sysrootPath) inputFile "Program.wasm" executeWasm step
step "Compare expected and actual program output"
assertEqDiff ("check: WASM output = " <> expectedFile) actualWasm expected
step "Compile C to native 64-bit code"
actualNative <- clangCompile native64Args inputFile "Program" executeNative step
step "Compare expected and actual program output"
assertEqDiff ("check: native output = " <> expectedFile) actualNative expected
commonArgs :: FilePath -> [String]
commonArgs outputFile =
[ "-DDEBUG",
"-W",
"-Wall",
"-Wno-unused-parameter",
"-Wno-unused-label",
"-Werror",
"-std=c11",
"-I",
runtimeInclude,
"-o",
outputFile
]
where
runtimeInclude :: FilePath
runtimeInclude = $(makeRelativeToProject "runtime/include" >>= strToExp)
native64Args :: FilePath -> FilePath -> [String]
native64Args outputFile inputFile =
commonArgs outputFile
<> [ "-DARCH_NATIVE64",
"-DAPI_LIBC",
"-m64",
"-O3",
"-L",
juvixLibraryDir,
inputFile,
"-ljuvix"
]
where
juvixLibraryDir :: FilePath
juvixLibraryDir = $(makeRelativeToProject "runtime/_build.native64-debug" >>= strToExp)
wasiArgs :: FilePath -> FilePath -> FilePath -> [String]
wasiArgs sysrootPath outputFile inputFile =
commonArgs outputFile
<> [ "-DARCH_WASM32",
"-DAPI_WASI",
"-Os",
"-nodefaultlibs",
"--target=wasm32-wasi",
"--sysroot",
sysrootPath,
"-L",
juvixLibraryDir,
inputFile,
"-ljuvix"
]
where
juvixLibraryDir :: FilePath
juvixLibraryDir = $(makeRelativeToProject "runtime/_build.wasm32-wasi-debug" >>= strToExp)

135
test/Runtime/Positive.hs Normal file
View File

@ -0,0 +1,135 @@
module Runtime.Positive where
import Base
import Runtime.Base
data PosTest = PosTest
{ _name :: String,
_relDir :: FilePath,
_file :: FilePath,
_expectedFile :: FilePath
}
makeLenses ''PosTest
root :: FilePath
root = "tests/runtime/positive/"
testDescr :: PosTest -> TestDescr
testDescr PosTest {..} =
let tRoot = root </> _relDir
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Steps $ clangAssertion _file _expectedFile ""
}
allTests :: TestTree
allTests =
testGroup
"Runtime positive tests"
(map (mkTest . testDescr) tests)
tests :: [PosTest]
tests =
[ PosTest
"HelloWorld"
"."
"test001.c"
"out/test001.out",
PosTest
"Page allocation"
"."
"test002.c"
"out/test002.out",
PosTest
"Printing of integers"
"."
"test003.c"
"out/test003.out",
PosTest
"Allocator for unstructured objects"
"."
"test004.c"
"out/test004.out",
PosTest
"Allocator for unstructured objects (macro API)"
"."
"test005.c"
"out/test005.out",
PosTest
"Stack"
"."
"test006.c"
"out/test006.out",
PosTest
"Prologue and epilogue"
"."
"test007.c"
"out/test007.out",
PosTest
"Basic arithmetic"
"."
"test008.c"
"out/test008.out",
PosTest
"Direct call"
"."
"test009.c"
"out/test009.out",
PosTest
"Indirect call"
"."
"test010.c"
"out/test010.out",
PosTest
"Tail calls"
"."
"test011.c"
"out/test011.out",
PosTest
"Tracing and strings"
"."
"test012.c"
"out/test012.out",
PosTest
"IO builtins"
"."
"test013.c"
"out/test013.out",
PosTest
"Higher-order functions"
"."
"test014.c"
"out/test014.out",
PosTest
"Branching, matching and recursion on lists"
"."
"test015.c"
"out/test015.out",
PosTest
"Closure extension"
"."
"test016.c"
"out/test016.out",
PosTest
"Recursion through higher-order functions"
"."
"test017.c"
"out/test017.out",
PosTest
"Tail recursion through higher-order functions"
"."
"test018.c"
"out/test018.out",
PosTest
"Dynamic closure extension"
"."
"test019.c"
"out/test019.out",
PosTest
"Higher-order function composition"
"."
"test020.c"
"out/test020.out"
]

3
tests/.gitattributes vendored
View File

@ -1 +1,2 @@
*.golden -text
*.golden -text
*.out -text

17
tests/benchmark/Makefile Normal file
View File

@ -0,0 +1,17 @@
.PHONY: compile
compile:
./compile.sh
.PHONY: clean
clean:
-rm `find . -name '*.wasm'` 2>/dev/null || true
-rm `find . -name '*.byte'` 2>/dev/null || true
-rm `find . -name '*.exe'` 2>/dev/null || true
-rm `find . -name '*.hi'` 2>/dev/null || true
-rm `find . -name '*.o'` 2>/dev/null || true
-rm `find . -name '*.cmo'` 2>/dev/null || true
-rm `find . -name '*.cmi'` 2>/dev/null || true
-rm `find . -name '*.cmx'` 2>/dev/null || true
-rm -rf `find . -name '.juvix-build'` 2>/dev/null || true
.SILENT: clean

52
tests/benchmark/ackermann/c/ackermann.c Normal file
View File

@ -0,0 +1,52 @@
// Ackermann function (higher-order definition)
#include <stdio.h>
#include <stdlib.h>
typedef uintptr_t uint;
typedef uint (*fun_t)(uint,uint);
typedef struct{
uint arg;
fun_t f;
} closure_t;
static uint iter(closure_t *cl, int n, uint x) {
while (n > 0) {
x = cl->f(cl->arg, x);
--n;
};
return x;
}
static uint step_2(uint f, uint n) {
return iter((closure_t*)f, n + 1, 1);
}
static uint step(uint dummy, uint x) {
closure_t *cl = malloc(sizeof(closure_t));
cl->arg = x;
cl->f = (fun_t)step_2;
return (uint)cl;
}
static uint plus(uint x, uint y) {
return x + y;
}
static int ackermann(int m, int n) {
closure_t *plus_one = malloc(sizeof(closure_t));
plus_one->arg = 1;
plus_one->f = plus;
closure_t *mystep = malloc(sizeof(closure_t));
mystep->arg = 0;
mystep->f = step;
closure_t *cl = (closure_t *)iter(mystep, m, (uint)plus_one);
return cl->f(cl->arg, n);
}
int main() {
printf("%d\n", ackermann(3, 11));
return 0;
}

12
tests/benchmark/ackermann/core/ackermann.jvc Normal file
View File

@ -0,0 +1,12 @@
-- Ackermann function (higher-order definition)
def iter := \f \n \x
if n = 0 then
x
else
f (iter f (n - 1) x);
def ackermann := \m
iter (\f \n iter f (n + 1) 1) m (+ 1);
ackermann 3 11

15
tests/benchmark/ackermann/haskell/ackermann.hs Normal file
View File

@ -0,0 +1,15 @@
-- Ackermann function (higher-order definition)
compose :: (a -> b) -> (b -> c) -> a -> c
compose f g x = g (f x)
iter :: (a -> a) -> Int -> a -> a
iter f 0 = id
iter f n = compose f (iter f (n - 1))
ackermann :: Int -> Int -> Int
ackermann m =
iter (\f n -> iter f (n + 1) 1) m (+ 1)
main :: IO ()
main = putStrLn (show (ackermann 3 11))

24
tests/benchmark/ackermann/juvix/Data/Int.juvix Normal file
View File

@ -0,0 +1,24 @@
module Data.Int;
axiom Int : Type;
compile Int {
c ↦ "int";
};
axiom Int_0 : Int;
compile Int_0 {
c ↦ "0";
};
axiom Int_1 : Int;
compile Int_1 {
c ↦ "1";
};
axiom Int_2 : Int;
compile Int_2 {
c ↦ "2";
};
end;

74
tests/benchmark/ackermann/juvix/Data/Int/Ops.juvix Normal file
View File

@ -0,0 +1,74 @@
module Data.Int.Ops;
open import Data.Int;
open import Stdlib.Data.Bool;
open import Stdlib.System.IO;
foreign c {
bool lessThan(int l, int r) {
return l < r;
\}
bool eqInt(int l, int r) {
return l == r;
\}
int plus(int l, int r) {
return l + r;
\}
int minus(int l, int r) {
return l - r;
\}
int modulo(int l, int r) {
return l % r;
\}
int printInt(int x) {
putStrLn(intToStr(x));
return 0;
\}
};
axiom printInt : Int → IO;
compile printInt {
c ↦ "printInt";
};
infix 4 <;
axiom < : Int → Int → Bool;
compile < {
c ↦ "lessThan";
};
axiom eqInt : Int → Int → Bool;
compile eqInt {
c ↦ "eqInt";
};
infix 4 ==;
axiom == : Int → Int → Bool;
compile == {
c ↦ "eqInt";
};
infixl 6 -;
axiom - : Int -> Int -> Int;
compile - {
c ↦ "minus";
};
infixl 6 +;
axiom + : Int -> Int -> Int;
compile + {
c ↦ "plus";
};
infixl 8 %;
axiom % : Int -> Int -> Int;
compile % {
c ↦ "modulo";
};
end;

32
tests/benchmark/ackermann/juvix/ackermann.juvix Normal file
View File

@ -0,0 +1,32 @@
-- Ackermann function (higher-order definition)
module ackermann;
open import Stdlib.Prelude;
open import Data.Int;
open import Data.Int.Ops;
terminating
iter : {A : Type} -> (A -> A) -> Int -> A -> A;
iter f n := if (n Data.Int.Ops.== Int_0) id (f ∘ (iter f (n Data.Int.Ops.- Int_1)));
step : (Int -> Int) -> Int -> Int;
step f n := iter f (n Data.Int.Ops.+ Int_1) Int_1;
ackermann : Int -> Int -> Int;
ackermann m :=
iter step m ((Data.Int.Ops.+) Int_1);
axiom Int_11 : Int;
compile Int_11 {
c ↦ "11";
};
axiom Int_3 : Int;
compile Int_3 {
c ↦ "3";
};
main : IO;
main := printInt (ackermann Int_3 Int_11);
end;

13
tests/benchmark/ackermann/ocaml/ackermann.ml Normal file
View File

@ -0,0 +1,13 @@
(* Ackermann function (higher-order definition) *)
let rec iter f n x =
if n = 0 then
x
else
f (iter f (n - 1) x)
let ackermann m =
iter (fun f n -> iter f (n + 1) 1) m ((+) 1);;
print_int (ackermann 3 11);;
print_newline ();;

124
tests/benchmark/ackermann/runtime/ackermann.c Normal file
View File

@ -0,0 +1,124 @@
/* Ackermann function (higher-order definition) */
#include <juvix/api.h>
#define JUVIX_DECL_ARGS \
DECL_REG_ARG(0); \
DECL_REG_ARG(1); \
DECL_REG_ARG(2)
static constr_info_t juvix_constr_info_array[BUILTIN_UIDS_NUM] = {
BUILTIN_UIDS_INFO};
int main() {
JUVIX_PROLOGUE(3, JUVIX_DECL_ARGS);
juvix_constrs_num = BUILTIN_UIDS_NUM;
juvix_constr_info = juvix_constr_info_array;
CALL(0, juvix_function_main, juvix_label_0);
goto juvix_program_end;
DECL_CURRY(1);
JUVIX_FUNCTION(iter, 2);
{
DECL_TMP(0);
JUVIX_INT_EQ(TMP(0), ARG(1), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = ARG(2);
RETURN;
},
{
STACK_PUSH(ARG(0));
JUVIX_INT_SUB(ARG(1), ARG(1), make_smallint(1));
CALL(0, iter, juvix_label_iter_1);
STACK_POP(ARG(0));
ASSIGN_CARGS(ARG(0),
{ CARG(juvix_closure_nargs) = juvix_result; });
TAIL_CALL_CLOSURE(ARG(0));
});
}
juvix_closure_step_2:
PREALLOC(
CURRY_CLOSURE_ALLOC_SIZE,
{
STACK_ENTER(2);
STACK_PUSH(CARG(0));
STACK_PUSH(CARG(1));
},
{
STACK_POP(CARG(1));
STACK_POP(CARG(0));
STACK_LEAVE;
});
CURRY_CLOSURE(ARG(0), CARG(0), 1);
ARG(1) = CARG(1);
JUVIX_FUNCTION_NS(step_2);
{
ARG(2) = make_smallint(1);
JUVIX_INT_ADD(ARG(1), ARG(1), make_smallint(1));
TAIL_CALL_NS(0, iter);
}
juvix_closure_step:
ARG(0) = CARG(0);
JUVIX_FUNCTION(step, 1);
{
PREALLOC(
CLOSURE_HEAD_SIZE + 1, { STACK_PUSH(ARG(0)); },
{ STACK_POP(ARG(0)); });
ALLOC_CLOSURE(juvix_result, 0, LABEL_ADDR(juvix_closure_step_2), 1, 1);
CLOSURE_ARG(juvix_result, 0) = ARG(0);
RETURN;
}
juvix_closure_plus:
ARG(0) = CARG(0);
ARG(1) = CARG(1);
JUVIX_FUNCTION_NS(plus);
{
JUVIX_INT_ADD(juvix_result, ARG(0), ARG(1));
RETURN_NS;
}
JUVIX_FUNCTION(ackermann, 2);
{
DECL_TMP(0); // step
DECL_TMP(1); // plus 1
PREALLOC(
2 * CLOSURE_HEAD_SIZE + 1,
{
STACK_PUSH(ARG(0));
STACK_PUSH(ARG(1));
},
{
STACK_POP(ARG(1));
STACK_POP(ARG(0));
});
ALLOC_CLOSURE(TMP(0), 0, LABEL_ADDR(juvix_closure_step), 0, 1);
ALLOC_CLOSURE(TMP(1), 0, LABEL_ADDR(juvix_closure_plus), 1, 1);
CLOSURE_ARG(TMP(1), 0) = make_smallint(1);
STACK_PUSH(ARG(1));
ARG(2) = TMP(1);
ARG(1) = ARG(0);
ARG(0) = TMP(0);
CALL(0, iter, juvix_label_ackermann_1);
STACK_POP(ARG(1));
ASSIGN_CARGS(juvix_result, { CARG(juvix_closure_nargs) = ARG(1); });
TAIL_CALL_CLOSURE(juvix_result);
}
JUVIX_FUNCTION_NS(juvix_function_main);
{
ARG(1) = make_smallint(11);
ARG(0) = make_smallint(3);
TAIL_CALL_NS(0, ackermann);
}
JUVIX_EPILOGUE;
return 0;
}

120
tests/benchmark/ackermann/runtime/ackermann_spec.c Normal file
View File

@ -0,0 +1,120 @@
/* Ackermann function (higher-order definition, specialised) */
#include <juvix/api.h>
#define JUVIX_DECL_ARGS \
DECL_REG_ARG(0); \
DECL_REG_ARG(1); \
DECL_REG_ARG(2)
static constr_info_t juvix_constr_info_array[BUILTIN_UIDS_NUM] = {
BUILTIN_UIDS_INFO};
int main() {
JUVIX_PROLOGUE(3, JUVIX_DECL_ARGS);
juvix_constrs_num = BUILTIN_UIDS_NUM;
juvix_constr_info = juvix_constr_info_array;
CALL(0, juvix_function_main, juvix_label_0);
goto juvix_program_end;
DECL_CURRY(1);
JUVIX_FUNCTION(iter, 2);
{
DECL_TMP(0);
JUVIX_INT_EQ(TMP(0), ARG(1), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = ARG(2);
RETURN;
},
{
STACK_PUSH(ARG(0));
JUVIX_INT_SUB(ARG(1), ARG(1), make_smallint(1));
CALL(0, iter, juvix_label_iter_1);
STACK_POP(ARG(0));
ASSIGN_CARGS(ARG(0),
{ CARG(juvix_closure_nargs) = juvix_result; });
TAIL_CALL_CLOSURE(ARG(0));
});
}
juvix_closure_step:
ARG(0) = CARG(0);
ARG(1) = CARG(1);
JUVIX_FUNCTION_NS(step);
{
ARG(2) = make_smallint(1);
JUVIX_INT_ADD(ARG(1), ARG(1), make_smallint(1));
TAIL_CALL_NS(0, iter);
}
JUVIX_FUNCTION(iter_outer, 2);
{
DECL_TMP(0);
JUVIX_INT_EQ(TMP(0), ARG(0), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = ARG(1);
RETURN;
},
{
JUVIX_INT_SUB(ARG(0), ARG(0), make_smallint(1));
CALL(0, iter_outer, juvix_label_iter_outer_1);
TMP(0) = juvix_result;
PREALLOC(
CLOSURE_HEAD_SIZE + 1, { STACK_PUSH(TMP(0)); },
{ STACK_POP(TMP(0)); });
ALLOC_CLOSURE(juvix_result, 0, LABEL_ADDR(juvix_closure_step),
1, 1);
CLOSURE_ARG(juvix_result, 0) = TMP(0);
RETURN;
});
}
juvix_closure_plus:
ARG(0) = CARG(0);
ARG(1) = CARG(1);
JUVIX_FUNCTION_NS(plus);
{
JUVIX_INT_ADD(juvix_result, ARG(0), ARG(1));
RETURN_NS;
}
JUVIX_FUNCTION(ackermann, 2);
{
DECL_TMP(0); // plus 1
PREALLOC(
2 * CLOSURE_HEAD_SIZE + 1,
{
STACK_PUSH(ARG(0));
STACK_PUSH(ARG(1));
},
{
STACK_POP(ARG(1));
STACK_POP(ARG(0));
});
ALLOC_CLOSURE(TMP(0), 0, LABEL_ADDR(juvix_closure_plus), 1, 1);
CLOSURE_ARG(TMP(0), 0) = make_smallint(1);
STACK_PUSH(ARG(1));
ARG(1) = TMP(0);
CALL(0, iter_outer, juvix_label_ackermann_1);
STACK_POP(ARG(1));
ASSIGN_CARGS(juvix_result, { CARG(juvix_closure_nargs) = ARG(1); });
TAIL_CALL_CLOSURE(juvix_result);
}
JUVIX_FUNCTION_NS(juvix_function_main);
{
ARG(1) = make_smallint(11);
ARG(0) = make_smallint(3);
TAIL_CALL_NS(0, ackermann);
}
JUVIX_EPILOGUE;
return 0;
}

20
tests/benchmark/combinations/c/combinations.c Normal file
View File

@ -0,0 +1,20 @@
// count combinations of numbers 1 to N having sum N
#include <stdio.h>
int combinations(int n, int s) {
if (s == 0) {
return 1;
} else if (n == 0) {
return 0;
} else if (s < 0) {
return 0;
} else {
return combinations(n, s - n) + combinations(n - 1, s);
}
}
int main() {
printf("%d\n", combinations(100, 100));
return 0;
}

13
tests/benchmark/combinations/core/combinations.jvc Normal file
View File

@ -0,0 +1,13 @@
-- count combinations of numbers 1 to N having sum N
def combinations := \n \s
if s = 0 then
1
else if n = 0 then
0
else if s < 0 then
0
else
combinations n (s - n) + combinations (n - 1) s;
combinations 100 100

12
tests/benchmark/combinations/haskell/combinations.hs Normal file
View File

@ -0,0 +1,12 @@
-- count combinations of numbers 1 to N having sum N
combinations :: Int -> Int
combinations n = go n n
where
go :: Int -> Int -> Int
go n 0 = 1
go 0 s = 0
go n s = if s <= 0 then 0 else go n (s - n) + go (n - 1) s
main :: IO ()
main = putStrLn (show (combinations 100))

24
tests/benchmark/combinations/juvix/Data/Int.juvix Normal file
View File

@ -0,0 +1,24 @@
module Data.Int;
axiom Int : Type;
compile Int {
c ↦ "int";
};
axiom Int_0 : Int;
compile Int_0 {
c ↦ "0";
};
axiom Int_1 : Int;
compile Int_1 {
c ↦ "1";
};
axiom Int_2 : Int;
compile Int_2 {
c ↦ "2";
};
end;

74
tests/benchmark/combinations/juvix/Data/Int/Ops.juvix Normal file
View File

@ -0,0 +1,74 @@
module Data.Int.Ops;
open import Data.Int;
open import Stdlib.Data.Bool;
open import Stdlib.System.IO;
foreign c {
bool lessThan(int l, int r) {
return l < r;
\}
bool eqInt(int l, int r) {
return l == r;
\}
int plus(int l, int r) {
return l + r;
\}
int minus(int l, int r) {
return l - r;
\}
int modulo(int l, int r) {
return l % r;
\}
int printInt(int x) {
putStrLn(intToStr(x));
return 0;
\}
};
axiom printInt : Int → IO;
compile printInt {
c ↦ "printInt";
};
infix 4 <;
axiom < : Int → Int → Bool;
compile < {
c ↦ "lessThan";
};
axiom eqInt : Int → Int → Bool;
compile eqInt {
c ↦ "eqInt";
};
infix 4 ==;
axiom == : Int → Int → Bool;
compile == {
c ↦ "eqInt";
};
infixl 6 -;
axiom - : Int -> Int -> Int;
compile - {
c ↦ "minus";
};
infixl 6 +;
axiom + : Int -> Int -> Int;
compile + {
c ↦ "plus";
};
infixl 8 %;
axiom % : Int -> Int -> Int;
compile % {
c ↦ "modulo";
};
end;

31
tests/benchmark/combinations/juvix/combinations.juvix Normal file
View File

@ -0,0 +1,31 @@
-- count combinations of numbers 1 to N having sum N
module combinations;
open import Stdlib.Prelude;
open import Data.Int;
open import Data.Int.Ops;
terminating
go : Int -> Int -> Int;
go n s :=
if (s Data.Int.Ops.== Int_0)
Int_1
(if (n Data.Int.Ops.== Int_0)
Int_0
(if (s Data.Int.Ops.< Int_0)
Int_0
(go n (s Data.Int.Ops.- n) Data.Int.Ops.+ go (n Data.Int.Ops.- Int_1) s)));
combinations : Int -> Int;
combinations n := go n n;
axiom Int_100 : Int;
compile Int_100 {
c ↦ "100";
};
main : IO;
main := printInt (combinations Int_100);
end;

19
tests/benchmark/combinations/ocaml/combinations.ml Normal file
View File

@ -0,0 +1,19 @@
(* count combinations of numbers 1 to N having sum N *)
let combinations n =
let rec go n s =
if s == 0 then
1
else if n == 0 then
0
else if s < 0 then
0
else
go n (s - n) + go (n - 1) s
in
go n n
;;
print_int (combinations 100);
print_newline ();

81
tests/benchmark/combinations/runtime/combinations.c Normal file
View File

@ -0,0 +1,81 @@
/* Compute the Nth Fibonacci number modulo 2^28 */
#include <juvix/api.h>
#define JUVIX_DECL_ARGS \
DECL_REG_ARG(0); \
DECL_REG_ARG(1)
#define CONSTRS_NUM BUILTIN_UIDS_NUM
static constr_info_t juvix_constr_info_array[CONSTRS_NUM] = {BUILTIN_UIDS_INFO};
int main() {
JUVIX_PROLOGUE(2, JUVIX_DECL_ARGS);
juvix_constrs_num = CONSTRS_NUM;
juvix_constr_info = juvix_constr_info_array;
CALL(0, juvix_function_main, juvix_label_0);
goto juvix_program_end;
JUVIX_FUNCTION(go, 3);
{
DECL_TMP(0);
JUVIX_INT_EQ(TMP(0), ARG(1), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = make_smallint(1);
RETURN;
},
{
JUVIX_INT_EQ(TMP(0), ARG(0), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = make_smallint(0);
RETURN;
},
{
JUVIX_INT_LT(TMP(0), ARG(1), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = make_smallint(0);
RETURN;
},
{
STACK_PUSH(ARG(0));
STACK_PUSH(ARG(1));
JUVIX_INT_SUB(ARG(1), ARG(1), ARG(0));
CALL(0, go, juvix_label_go_1);
STACK_POP(ARG(1));
STACK_POP(ARG(0));
STACK_PUSH(juvix_result);
JUVIX_INT_SUB(ARG(0), ARG(0), make_smallint(1));
CALL(0, go, juvix_label_go_2);
STACK_POP(TMP(0));
JUVIX_INT_ADD(juvix_result, juvix_result,
TMP(0));
RETURN;
});
});
});
}
JUVIX_FUNCTION_NS(combinations);
{
ARG(1) = ARG(0);
TAIL_CALL_NS(0, go);
}
JUVIX_FUNCTION_NS(juvix_function_main);
{
ARG(0) = make_smallint(100);
TAIL_CALL_NS(0, combinations);
}
JUVIX_EPILOGUE;
return 0;
}

59
tests/benchmark/compile.sh Executable file
View File

@ -0,0 +1,59 @@
#!/bin/bash
function execute() {
echo $1
eval $1
}
for d in *
do
if [ -d "$d" ]; then
echo
echo "Compiling $d..."
echo
cd $d
if [ -d haskell ]; then
cd haskell
for f in *.hs; do
execute "ghc -O2 -o `basename $f .hs`.exe $f"
rm *.hi *.o
execute "ghc -XStrict -O2 -o `basename $f .hs`.strict.exe $f"
rm *.hi *.o
done
cd ..
fi
if [ -d ocaml ]; then
cd ocaml
for f in *.ml; do
execute "ocamlopt -O2 -o `basename $f .ml`.exe $f"
execute "ocamlc -o `basename $f .ml`.byte.exe $f"
done
cd ..
fi
if [ -d juvix ]; then
cd juvix
for f in *.juvix; do
execute "juvix compile -o `basename $f .juvix`.exe $f"
execute "juvix compile --target=wasm -o `basename $f .juvix`.wasm $f"
done
cd ..
fi
if [ -d runtime ]; then
cd runtime
for f in *.c; do
execute "juvix dev runtime compile -o `basename $f .c`.exe $f"
execute "juvix dev runtime compile --target=wasm32-wasi -o `basename $f .c`.wasm $f"
done
cd ..
fi
if [ -d c ]; then
cd c
for f in *.c; do
execute "clang -O3 -o `basename $f .c`.exe $f"
execute "clang -Os --target=wasm32-wasi --sysroot $WASI_SYSROOT_PATH -o `basename $f .c`.wasm $f"
done
cd ..
fi
cd ..
fi
done

22
tests/benchmark/cps/c/cps.c Normal file
View File

@ -0,0 +1,22 @@
// Compute the Nth Fibonacci number modulo 2 ^ 28
#include <stdio.h>
typedef int (*fun_t)(int, int, int);
static int step(int k, int n, int m, fun_t cont) {
if (k == 0) {
return n;
} else {
return cont(k - 1, m, (n + m) % (1 << 28));
}
}
static int fib_go(int k, int n, int m) {
return step(k, n, m, fib_go);
}
int main() {
printf("%d\n", fib_go(100000000, 0, 1));
return 0;
}

14
tests/benchmark/cps/core/cps.jvc Normal file
View File

@ -0,0 +1,14 @@
-- compute the Nth Fibonacci number modulo 2^28 with CPS
def step := \k \n \m \cont
if k = 0 then
n
else
cont (k - 1) m ((n + m) % 268435456);
def go := \k \n \m step k n m go;
def fib := \k
go k 0 1;
fib 100000000

14
tests/benchmark/cps/haskell/cps.hs Normal file
View File

@ -0,0 +1,14 @@
-- compute the Nth Fibonacci number modulo 2^28 with CPS
go :: Int -> Int -> Int -> Int
go k n m = step k n m go
step :: Int -> Int -> Int -> (Int -> Int -> Int -> Int) -> Int
step 0 n m cont = n
step k n m cont = cont (k - 1) m ((n + m) `mod` (2 ^ 28))
fib :: Int -> Int
fib n = go n 0 1
main :: IO ()
main = putStrLn (show (fib 100000000))

24
tests/benchmark/cps/juvix/Data/Int.juvix Normal file
View File

@ -0,0 +1,24 @@
module Data.Int;
axiom Int : Type;
compile Int {
c ↦ "int";
};
axiom Int_0 : Int;
compile Int_0 {
c ↦ "0";
};
axiom Int_1 : Int;
compile Int_1 {
c ↦ "1";
};
axiom Int_2 : Int;
compile Int_2 {
c ↦ "2";
};
end;

84
tests/benchmark/cps/juvix/Data/Int/Ops.juvix Normal file
View File

@ -0,0 +1,84 @@
module Data.Int.Ops;
open import Data.Int;
open import Stdlib.Data.Bool;
open import Stdlib.System.IO;
foreign c {
bool lessThan(int l, int r) {
return l < r;
\}
bool eqInt(int l, int r) {
return l == r;
\}
int plus(int l, int r) {
return l + r;
\}
int minus(int l, int r) {
return l - r;
\}
int mult(int l, int r) {
return l % r;
\}
int modulo(int l, int r) {
return l % r;
\}
int printInt(int x) {
putStrLn(intToStr(x));
return 0;
\}
};
axiom printInt : Int → IO;
compile printInt {
c ↦ "printInt";
};
infix 4 <;
axiom < : Int → Int → Bool;
compile < {
c ↦ "lessThan";
};
axiom eqInt : Int → Int → Bool;
compile eqInt {
c ↦ "eqInt";
};
infix 4 ==;
axiom == : Int → Int → Bool;
compile == {
c ↦ "eqInt";
};
infixl 6 -;
axiom - : Int -> Int -> Int;
compile - {
c ↦ "minus";
};
infixl 6 +;
axiom + : Int -> Int -> Int;
compile + {
c ↦ "plus";
};
infixl 8 %;
axiom % : Int -> Int -> Int;
compile % {
c ↦ "modulo";
};
infixl 8 *;
axiom * : Int -> Int -> Int;
compile * {
c ↦ "mult";
};
end;

37
tests/benchmark/cps/juvix/cps.juvix Normal file
View File

@ -0,0 +1,37 @@
-- compute the Nth Fibonacci number modulo 2 ^ 28 with CPS
module cps;
open import Stdlib.Prelude;
open import Data.Int;
open import Data.Int.Ops;
open import Stdlib.Prelude;
open import Data.Int;
open import Data.Int.Ops;
axiom Int_268435456 : Int;
compile Int_268435456 {
c ↦ "268435456";
};
step : Int -> Int -> Int -> (Int -> Int -> Int -> Int) -> Int;
step k n m cont := if (k Data.Int.Ops.== Int_0)
n
(cont (k Data.Int.Ops.- Int_1) m ((n Data.Int.Ops.+ m) Data.Int.Ops.% Int_268435456));
terminating
go : Int -> Int -> Int -> Int;
go k n m := step k n m go;
fib : Int -> Int;
fib n := go n Int_0 Int_1;
axiom Int_100000000 : Int;
compile Int_100000000 {
c ↦ "100000000";
};
main : IO;
main := printInt (fib Int_100000000);
end;

16
tests/benchmark/cps/ocaml/cps.ml Normal file
View File

@ -0,0 +1,16 @@
(* compute the Nth Fibonacci number modulo 2^28 with CPS *)
let step k n m cont =
if k == 0 then
n
else
cont (k - 1) m ((n + m) mod 268435456)
let rec go k n m = step k n m go
let fib k = go k 0 1
;;
print_int (fib 100000000);
print_newline ()

76
tests/benchmark/cps/runtime/cps.c Normal file
View File

@ -0,0 +1,76 @@
/* Compute the Nth Fibonacci number modulo 2^28 with CPS */
#include <juvix/api.h>
#define JUVIX_DECL_ARGS \
DECL_REG_ARG(0); \
DECL_REG_ARG(1); \
DECL_REG_ARG(2); \
DECL_REG_ARG(3);
#define CONSTRS_NUM BUILTIN_UIDS_NUM
static constr_info_t juvix_constr_info_array[CONSTRS_NUM] = {BUILTIN_UIDS_INFO};
int main() {
JUVIX_PROLOGUE(3, JUVIX_DECL_ARGS);
juvix_constrs_num = CONSTRS_NUM;
juvix_constr_info = juvix_constr_info_array;
DECL_ZEROARG_CLOSURE(fib_go, 0, 3);
CALL(0, juvix_function_main, juvix_label_0);
goto juvix_program_end;
JUVIX_FUNCTION_NS(fib_step);
{
DECL_TMP(0);
JUVIX_INT_EQ(TMP(0), ARG(0), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = ARG(1);
RETURN_NS;
},
{
JUVIX_INT_SUB(ARG(0), ARG(0), make_smallint(1));
TMP(0) = ARG(1);
ARG(1) = ARG(2);
JUVIX_INT_ADD(ARG(2), ARG(2), TMP(0));
JUVIX_INT_MOD(ARG(2), ARG(2), make_smallint(1 << 28));
ASSIGN_CARGS(ARG(3), {
CARG(juvix_closure_nargs) = ARG(0);
CARG(juvix_closure_nargs + 1) = ARG(1);
CARG(juvix_closure_nargs + 2) = ARG(2);
});
TAIL_CALL_CLOSURE_NS(ARG(3));
});
}
juvix_closure_fib_go:
ARG(0) = CARG(0);
ARG(1) = CARG(1);
ARG(2) = CARG(2);
JUVIX_FUNCTION_NS(fib_go);
{
ARG(3) = juvix_zeroarg_closure_fib_go;
TAIL_CALL_NS(0, fib_step);
}
JUVIX_FUNCTION_NS(fib);
{
ARG(1) = make_smallint(0);
ARG(2) = make_smallint(1);
TAIL_CALL_NS(0, fib_go);
}
JUVIX_FUNCTION_NS(juvix_function_main);
{
ARG(0) = make_smallint(100000000);
TAIL_CALL_NS(0, fib);
}
JUVIX_EPILOGUE;
return 0;
}

19
tests/benchmark/fibonacci/c/fibonacci.c Normal file
View File

@ -0,0 +1,19 @@
// Compute the Nth Fibonacci number modulo 2 ^ 28
#include <stdio.h>
static int fib(int k) {
int n = 0;
int m = 1;
for (int i = 0; i < k; ++i) {
int x = (n + m) % (1 << 28);
n = m;
m = x;
}
return n;
}
int main() {
printf("%d\n", fib(100000000));
return 0;
}

12
tests/benchmark/fibonacci/core/fibonacci.jvc Normal file
View File

@ -0,0 +1,12 @@
-- compute the Nth Fibonacci number modulo 2^28
def fib := \k
letrec go := \k \n \m
if k = 0 then
n
else
go (k - 1) m ((n + m) % 268435456)
in
go k 0 1;
fib 100000000

11
tests/benchmark/fibonacci/haskell/fibonacci.hs Normal file
View File

@ -0,0 +1,11 @@
-- compute the Nth Fibonacci number modulo 2^28
fib :: Int -> Int
fib n = go n 0 1
where
go :: Int -> Int -> Int -> Int
go 0 n m = n
go k n m = go (k - 1) m ((n + m) `mod` (2 ^ 28))
main :: IO ()
main = putStrLn (show (fib 100000000))

24
tests/benchmark/fibonacci/juvix/Data/Int.juvix Normal file
View File

@ -0,0 +1,24 @@
module Data.Int;
axiom Int : Type;
compile Int {
c ↦ "int";
};
axiom Int_0 : Int;
compile Int_0 {
c ↦ "0";
};
axiom Int_1 : Int;
compile Int_1 {
c ↦ "1";
};
axiom Int_2 : Int;
compile Int_2 {
c ↦ "2";
};
end;

74
tests/benchmark/fibonacci/juvix/Data/Int/Ops.juvix Normal file
View File

@ -0,0 +1,74 @@
module Data.Int.Ops;
open import Data.Int;
open import Stdlib.Data.Bool;
open import Stdlib.System.IO;
foreign c {
bool lessThan(int l, int r) {
return l < r;
\}
bool eqInt(int l, int r) {
return l == r;
\}
int plus(int l, int r) {
return l + r;
\}
int minus(int l, int r) {
return l - r;
\}
int modulo(int l, int r) {
return l % r;
\}
int printInt(int x) {
putStrLn(intToStr(x));
return 0;
\}
};
axiom printInt : Int → IO;
compile printInt {
c ↦ "printInt";
};
infix 4 <;
axiom < : Int → Int → Bool;
compile < {
c ↦ "lessThan";
};
axiom eqInt : Int → Int → Bool;
compile eqInt {
c ↦ "eqInt";
};
infix 4 ==;
axiom == : Int → Int → Bool;
compile == {
c ↦ "eqInt";
};
infixl 6 -;
axiom - : Int -> Int -> Int;
compile - {
c ↦ "minus";
};
infixl 6 +;
axiom + : Int -> Int -> Int;
compile + {
c ↦ "plus";
};
infixl 8 %;
axiom % : Int -> Int -> Int;
compile % {
c ↦ "modulo";
};
end;

31
tests/benchmark/fibonacci/juvix/fibonacci.juvix Normal file
View File

@ -0,0 +1,31 @@
-- compute the Nth Fibonacci number modulo 2^28
module fibonacci;
open import Stdlib.Prelude;
open import Data.Int;
open import Data.Int.Ops;
axiom Int_268435456 : Int;
compile Int_268435456 {
c ↦ "268435456";
};
terminating
go : Int -> Int -> Int -> Int;
go k n m := if (k Data.Int.Ops.== Int_0)
n
(go (k Data.Int.Ops.- Int_1) m ((n Data.Int.Ops.+ m) Data.Int.Ops.% Int_268435456));
fib : Int -> Int;
fib n := go n Int_0 Int_1;
axiom Int_100000000 : Int;
compile Int_100000000 {
c ↦ "100000000";
};
main : IO;
main := printInt (fib Int_100000000);
end;

15
tests/benchmark/fibonacci/ocaml/fibonacci.ml Normal file
View File

@ -0,0 +1,15 @@
(* compute the Nth Fibonacci number modulo 2^28 *)
let fib k =
let rec go k n m =
if k == 0 then
n
else
go (k - 1) m ((n + m) mod 268435456)
in
go k 0 1
;;
print_int (fib 100000000);
print_newline ()

58
tests/benchmark/fibonacci/runtime/fibonacci.c Normal file
View File

@ -0,0 +1,58 @@
/* Compute the Nth Fibonacci number modulo 2^28 */
#include <juvix/api.h>
#define JUVIX_DECL_ARGS \
DECL_REG_ARG(0); \
DECL_REG_ARG(1); \
DECL_REG_ARG(2)
#define CONSTRS_NUM BUILTIN_UIDS_NUM
static constr_info_t juvix_constr_info_array[CONSTRS_NUM] = {BUILTIN_UIDS_INFO};
int main() {
JUVIX_PROLOGUE(3, JUVIX_DECL_ARGS);
juvix_constrs_num = CONSTRS_NUM;
juvix_constr_info = juvix_constr_info_array;
CALL(0, juvix_function_main, juvix_label_0);
goto juvix_program_end;
JUVIX_FUNCTION_NS(fib_go);
{
DECL_TMP(0);
JUVIX_INT_EQ(TMP(0), ARG(0), make_smallint(0));
JUVIX_BRANCH(
TMP(0),
{
juvix_result = ARG(1);
RETURN_NS;
},
{
JUVIX_INT_SUB(ARG(0), ARG(0), make_smallint(1));
TMP(0) = ARG(1);
ARG(1) = ARG(2);
JUVIX_INT_ADD(ARG(2), ARG(2), TMP(0));
JUVIX_INT_MOD(ARG(2), ARG(2), make_smallint(1 << 28));
TAIL_CALL_NS(0, fib_go);
});
}
JUVIX_FUNCTION_NS(fib);
{
ARG(1) = make_smallint(0);
ARG(2) = make_smallint(1);
TAIL_CALL_NS(0, fib_go);
}
JUVIX_FUNCTION_NS(juvix_function_main);
{
ARG(0) = make_smallint(100000000);
TAIL_CALL_NS(0, fib);
}
JUVIX_EPILOGUE;
return 0;
}

27
tests/benchmark/fold/core/fold.jvc Normal file
View File

@ -0,0 +1,27 @@
-- fold a list of N integers
inductive list {
nil : list;
cons : any -> list -> list;
};
def plusMod := \x \y (x + y) % 268435456;
def foldl := \f \acc \lst case lst of {
nil := acc;
cons h t := foldl f (f acc h) t;
};
def run := \n \acc \lst
if n = 0 then
foldl plusMod acc lst
else
run (n - 1) (foldl plusMod (0 - acc) lst) lst;
def gen := \n \acc
if n = 0 then
acc
else
gen (n - 1) (cons n acc);
run 1000 0 (gen 100000 nil)

16
tests/benchmark/fold/haskell/fold.hs Normal file
View File

@ -0,0 +1,16 @@
-- fold a list of N integers
import Data.List
plusMod :: Int -> Int -> Int
plusMod x y = (x + y) `mod` (2 ^ 28)
run :: Int -> Int -> [Int] -> Int
run 0 acc lst = foldl' plusMod acc lst
run n acc lst = run (n - 1) (foldl' plusMod (-acc) lst) lst
main :: IO ()
main = putStrLn (show (run k 0 [1 .. n]))
where
k = 1000
n = 100000

24
tests/benchmark/fold/juvix/Data/Int.juvix Normal file
View File

@ -0,0 +1,24 @@
module Data.Int;
axiom Int : Type;
compile Int {
c ↦ "int";
};
axiom Int_0 : Int;
compile Int_0 {
c ↦ "0";
};
axiom Int_1 : Int;
compile Int_1 {
c ↦ "1";
};
axiom Int_2 : Int;
compile Int_2 {
c ↦ "2";
};
end;

Some files were not shown because too many files have changed in this diff Show More