mirror of
https://github.com/anoma/juvix.git
synced 2024-11-22 23:23:06 +03:00
Juvix C runtime (#1580)
This commit is contained in:
Łukasz Czajka
GitHub
parent
23c2b9e713
commit
74bfe592f5
1
.clang-format
Normal file
1
.clang-format
Normal file
@ -0,0 +1 @@
|
||||
{ BasedOnStyle: Google, IndentWidth: 4 }
|
||||
30
.github/workflows/ci.yml
vendored
30
.github/workflows/ci.yml
vendored
@ -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
9
.gitignore
vendored
@ -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
|
||||
|
||||
39
Makefile
39
Makefile
@ -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:
|
||||
@ -164,25 +173,45 @@ submodules:
|
||||
@git submodule update --init --recursive
|
||||
|
||||
.PHONY: build
|
||||
build: submodules
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
9
app/Commands/Dev/Runtime.hs
Normal 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
175
app/Commands/Dev/Runtime/Compile.hs
Normal 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
63
app/Commands/Dev/Runtime/Compile/Options.hs
Normal 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
24
app/Commands/Dev/Runtime/Options.hs
Normal 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")
|
||||
@ -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
326
docs/org/notes/runtime-benchmark-results.org
Normal 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
55
runtime/Makefile
Normal 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
313
runtime/Makefile.generic
Normal 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
34
runtime/PROJECT
Normal 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
137
runtime/src/juvix/api.h
Normal 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
123
runtime/src/juvix/arch/defs.h
Normal 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
17
runtime/src/juvix/arch/wasi.c
Normal 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
33
runtime/src/juvix/arch/wasi.h
Normal 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
27
runtime/src/juvix/config.h
Normal 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
88
runtime/src/juvix/defs.h
Normal 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
13
runtime/src/juvix/funcall.h
Normal 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
233
runtime/src/juvix/funcall/funcall.h
Normal 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
69
runtime/src/juvix/funcall/stacktrace.c
Normal 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
34
runtime/src/juvix/funcall/stacktrace.h
Normal 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
7
runtime/src/juvix/info.c
Normal 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
19
runtime/src/juvix/info.h
Normal 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
144
runtime/src/juvix/io.c
Normal 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
44
runtime/src/juvix/io.h
Normal 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
49
runtime/src/juvix/limits.h
Normal 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
19
runtime/src/juvix/mem.h
Normal 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
49
runtime/src/juvix/mem/alloc.c
Normal 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
60
runtime/src/juvix/mem/alloc.h
Normal 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
101
runtime/src/juvix/mem/gens.c
Normal 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
42
runtime/src/juvix/mem/gens.h
Normal 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
302
runtime/src/juvix/mem/mem.c
Normal 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
44
runtime/src/juvix/mem/mem.h
Normal 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
112
runtime/src/juvix/mem/pages.c
Normal 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
31
runtime/src/juvix/mem/pages.h
Normal 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
28
runtime/src/juvix/mem/stack.c
Normal 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
34
runtime/src/juvix/mem/stack.h
Normal 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
12
runtime/src/juvix/object.h
Normal 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
12
runtime/src/juvix/object/boolean.h
Normal 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
15
runtime/src/juvix/object/closure.c
Normal 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
123
runtime/src/juvix/object/closure.h
Normal 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
54
runtime/src/juvix/object/constr.h
Normal 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
29
runtime/src/juvix/object/cstring.c
Normal 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
39
runtime/src/juvix/object/cstring.h
Normal 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
24
runtime/src/juvix/object/equality.c
Normal 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
12
runtime/src/juvix/object/equality.h
Normal 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
34
runtime/src/juvix/object/integer.h
Normal 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
187
runtime/src/juvix/object/object.h
Normal 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
230
runtime/src/juvix/object/print.c
Normal 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
17
runtime/src/juvix/object/print.h
Normal 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
5
runtime/src/juvix/opts.c
Normal 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
23
runtime/src/juvix/opts.h
Normal 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
|
||||
@ -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
|
||||
}
|
||||
|
||||
|
||||
@ -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
7
test/Runtime.hs
Normal 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
109
test/Runtime/Base.hs
Normal 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
135
test/Runtime/Positive.hs
Normal 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"
|
||||
]
|
||||
1
tests/.gitattributes
vendored
1
tests/.gitattributes
vendored
@ -1 +1,2 @@
|
||||
*.golden -text
|
||||
*.out -text
|
||||
|
||||
17
tests/benchmark/Makefile
Normal file
17
tests/benchmark/Makefile
Normal 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
52
tests/benchmark/ackermann/c/ackermann.c
Normal 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
12
tests/benchmark/ackermann/core/ackermann.jvc
Normal 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
15
tests/benchmark/ackermann/haskell/ackermann.hs
Normal 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
24
tests/benchmark/ackermann/juvix/Data/Int.juvix
Normal 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
74
tests/benchmark/ackermann/juvix/Data/Int/Ops.juvix
Normal 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
32
tests/benchmark/ackermann/juvix/ackermann.juvix
Normal 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
13
tests/benchmark/ackermann/ocaml/ackermann.ml
Normal 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
124
tests/benchmark/ackermann/runtime/ackermann.c
Normal 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
120
tests/benchmark/ackermann/runtime/ackermann_spec.c
Normal 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
20
tests/benchmark/combinations/c/combinations.c
Normal 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
13
tests/benchmark/combinations/core/combinations.jvc
Normal 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
12
tests/benchmark/combinations/haskell/combinations.hs
Normal 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
24
tests/benchmark/combinations/juvix/Data/Int.juvix
Normal 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
74
tests/benchmark/combinations/juvix/Data/Int/Ops.juvix
Normal 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
31
tests/benchmark/combinations/juvix/combinations.juvix
Normal 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
19
tests/benchmark/combinations/ocaml/combinations.ml
Normal 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
81
tests/benchmark/combinations/runtime/combinations.c
Normal 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
59
tests/benchmark/compile.sh
Executable 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
22
tests/benchmark/cps/c/cps.c
Normal 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
14
tests/benchmark/cps/core/cps.jvc
Normal 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
14
tests/benchmark/cps/haskell/cps.hs
Normal 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
24
tests/benchmark/cps/juvix/Data/Int.juvix
Normal 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
84
tests/benchmark/cps/juvix/Data/Int/Ops.juvix
Normal 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
37
tests/benchmark/cps/juvix/cps.juvix
Normal 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
16
tests/benchmark/cps/ocaml/cps.ml
Normal 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
76
tests/benchmark/cps/runtime/cps.c
Normal 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
19
tests/benchmark/fibonacci/c/fibonacci.c
Normal 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
12
tests/benchmark/fibonacci/core/fibonacci.jvc
Normal 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
11
tests/benchmark/fibonacci/haskell/fibonacci.hs
Normal 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
24
tests/benchmark/fibonacci/juvix/Data/Int.juvix
Normal 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
74
tests/benchmark/fibonacci/juvix/Data/Int/Ops.juvix
Normal 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
31
tests/benchmark/fibonacci/juvix/fibonacci.juvix
Normal 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
15
tests/benchmark/fibonacci/ocaml/fibonacci.ml
Normal 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
58
tests/benchmark/fibonacci/runtime/fibonacci.c
Normal 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
27
tests/benchmark/fold/core/fold.jvc
Normal 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
16
tests/benchmark/fold/haskell/fold.hs
Normal 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
24
tests/benchmark/fold/juvix/Data/Int.juvix
Normal 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
Loading…
Reference in New Issue
Block a user