mirror of
https://github.com/janet-lang/janet
synced 2025-11-26 04:04:49 +00:00
Compare commits
1 Commits
compile-op
...
no-critica
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
624afe1336 |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -37,7 +37,6 @@ temp.janet
|
|||||||
temp.c
|
temp.c
|
||||||
temp*janet
|
temp*janet
|
||||||
temp*.c
|
temp*.c
|
||||||
temp.*
|
|
||||||
scratch.janet
|
scratch.janet
|
||||||
scratch.c
|
scratch.c
|
||||||
|
|
||||||
|
|||||||
@@ -2,10 +2,6 @@
|
|||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## Unreleased - ???
|
## Unreleased - ???
|
||||||
- Add `os/posix-chroot`
|
|
||||||
- Fix `ev/deadline` with interrupt race condition bug on Windows.
|
|
||||||
- Improve `flycheck` by allowing functions and macros to define their own flycheck behavior via the metadata `:flycheck`.
|
|
||||||
- Add `*flychecking*` dynamic binding to check if inside flycheck evalutation
|
|
||||||
- Add `gcperthread` callback for abstract types. This lets threaded abstracts have a finalizer that is called per thread, as well as a global finalizer.
|
- Add `gcperthread` callback for abstract types. This lets threaded abstracts have a finalizer that is called per thread, as well as a global finalizer.
|
||||||
- Add `JANET_DO_ERROR_*` flags to describe the return value of `janet_dobytes` and `janet_dostring`.
|
- Add `JANET_DO_ERROR_*` flags to describe the return value of `janet_dobytes` and `janet_dostring`.
|
||||||
|
|
||||||
|
|||||||
8
Makefile
8
Makefile
@@ -53,7 +53,7 @@ STRIPFLAGS=-x -S
|
|||||||
HOSTCC?=$(CC)
|
HOSTCC?=$(CC)
|
||||||
HOSTAR?=$(AR)
|
HOSTAR?=$(AR)
|
||||||
# Symbols are (optionally) removed later, keep -g as default!
|
# Symbols are (optionally) removed later, keep -g as default!
|
||||||
CFLAGS?=-O0 -g
|
CFLAGS?=-O2 -g
|
||||||
LDFLAGS?=-rdynamic
|
LDFLAGS?=-rdynamic
|
||||||
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
||||||
RUN:=$(RUN)
|
RUN:=$(RUN)
|
||||||
@@ -138,8 +138,7 @@ JANET_LOCAL_HEADERS=src/core/features.h \
|
|||||||
src/core/regalloc.h \
|
src/core/regalloc.h \
|
||||||
src/core/compile.h \
|
src/core/compile.h \
|
||||||
src/core/emit.h \
|
src/core/emit.h \
|
||||||
src/core/symcache.h \
|
src/core/symcache.h
|
||||||
src/core/sysir.h
|
|
||||||
|
|
||||||
JANET_CORE_SOURCES=src/core/abstract.c \
|
JANET_CORE_SOURCES=src/core/abstract.c \
|
||||||
src/core/array.c \
|
src/core/array.c \
|
||||||
@@ -174,9 +173,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
|||||||
src/core/strtod.c \
|
src/core/strtod.c \
|
||||||
src/core/struct.c \
|
src/core/struct.c \
|
||||||
src/core/symcache.c \
|
src/core/symcache.c \
|
||||||
src/core/sysir.c \
|
|
||||||
src/core/sysir_c.c \
|
|
||||||
src/core/sysir_x86.c \
|
|
||||||
src/core/table.c \
|
src/core/table.c \
|
||||||
src/core/tuple.c \
|
src/core/tuple.c \
|
||||||
src/core/util.c \
|
src/core/util.c \
|
||||||
|
|||||||
@@ -20,11 +20,11 @@
|
|||||||
@setlocal
|
@setlocal
|
||||||
|
|
||||||
@rem Example use asan
|
@rem Example use asan
|
||||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi /DEBUG
|
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
|
||||||
@set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib /DEBUG
|
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
|
||||||
|
|
||||||
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||||
@rem set JANET_LINK=link /nologo
|
@set JANET_LINK=link /nologo
|
||||||
|
|
||||||
@set JANET_LINK_STATIC=lib /nologo
|
@set JANET_LINK_STATIC=lib /nologo
|
||||||
|
|
||||||
|
|||||||
@@ -1,71 +0,0 @@
|
|||||||
###
|
|
||||||
### Create a .bmp file on linux.
|
|
||||||
###
|
|
||||||
|
|
||||||
# Quick run and view on Linux:
|
|
||||||
# build/janet examples/sysir/drawing.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
|
|
||||||
|
|
||||||
(use ./frontend)
|
|
||||||
|
|
||||||
(defn-external write:void [fd:int mem:pointer size:uint])
|
|
||||||
(defn-external exit:void [x:int])
|
|
||||||
|
|
||||||
# assume 128x128 32 bit color image
|
|
||||||
# Size : 128 * 128 * 4 + align(14 + 40, 4) = 65592
|
|
||||||
# dib offset : align(14 + 40, 4) = 56
|
|
||||||
|
|
||||||
(defsys write_32:void [x:uint]
|
|
||||||
(write 1 (address x) 4)
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys write_16:void [x:uint]
|
|
||||||
(write 1 (address x) 2)
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys write_header:void [w:uint h:uint]
|
|
||||||
(write 1 "BM" 2)
|
|
||||||
(def size:uint (+ 56 (* w h 4)))
|
|
||||||
(write_32 size)
|
|
||||||
(write_32 0)
|
|
||||||
(write_32 56) # pixel array offset
|
|
||||||
# Begin DIB
|
|
||||||
(write_32 40) # dib size
|
|
||||||
(write_32 w)
|
|
||||||
(write_32 h)
|
|
||||||
(write_16 1) # color panes - must be 1
|
|
||||||
(write_16 32) # bits per pixel
|
|
||||||
(write_32 0) # compression method - no compression
|
|
||||||
(write_32 0) # image size - not needed when no compression, 0 should be fine
|
|
||||||
(write_32 4096) # pixels per meter - horizontal resolution
|
|
||||||
(write_32 4096) # pixels per meter - vertical resolution
|
|
||||||
(write_32 0) # number of colors in palette - no palette so 0
|
|
||||||
(write_32 0) # number of "important colors" ignored in practice
|
|
||||||
(write_16 0) # add "gap 1" to align pixel array to multiple of 4 bytes
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys draw:void [w:uint h:uint]
|
|
||||||
(def red:uint 0xFFFF0000)
|
|
||||||
(def blue:uint 0xFF0000FF)
|
|
||||||
(def size:uint (* w h 4))
|
|
||||||
(var y:uint 0)
|
|
||||||
(while (< y h)
|
|
||||||
(var x:uint 0)
|
|
||||||
(while (< x w)
|
|
||||||
(write_32 (if (> y 64) blue red))
|
|
||||||
(set x (+ 1 x)))
|
|
||||||
(set y (+ y 1)))
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys main:int []
|
|
||||||
(def w:uint 512)
|
|
||||||
(def h:uint 512)
|
|
||||||
(write_header w h)
|
|
||||||
(draw w h)
|
|
||||||
(return 0))
|
|
||||||
|
|
||||||
####
|
|
||||||
|
|
||||||
#(dump)
|
|
||||||
(print "#include <unistd.h>")
|
|
||||||
(dumpc)
|
|
||||||
#(dumpx64)
|
|
||||||
@@ -1,86 +0,0 @@
|
|||||||
###
|
|
||||||
### Create a .bmp file on linux.
|
|
||||||
###
|
|
||||||
|
|
||||||
# Quick run and view on Linux:
|
|
||||||
# build/janet examples/sysir/drawing2.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
|
|
||||||
|
|
||||||
(use ./frontend)
|
|
||||||
|
|
||||||
(setdyn :verbose true)
|
|
||||||
|
|
||||||
# Pointer types
|
|
||||||
(defpointer p32 uint)
|
|
||||||
(defpointer p16 u16)
|
|
||||||
(defpointer cursor p32)
|
|
||||||
|
|
||||||
# External
|
|
||||||
(defn-external write:void [fd:int mem:pointer size:uint])
|
|
||||||
(defn-external exit:void [x:int])
|
|
||||||
(defn-external malloc:p32 [size:uint])
|
|
||||||
|
|
||||||
(defsys w32:void [c:cursor x:uint]
|
|
||||||
(def p:p32 (load c))
|
|
||||||
(store p x)
|
|
||||||
(store c (the p32 (pointer-add p 1)))
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys w16:void [c:cursor x:uint]
|
|
||||||
# Casting needs revisiting
|
|
||||||
(def p:p16 (cast (the p32 (load c))))
|
|
||||||
(store p (the u16 (cast x)))
|
|
||||||
(store c (the p32 (cast (the p16 (pointer-add p 1)))))
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys makebmp:p32 [w:uint h:uint]
|
|
||||||
(def size:uint (+ 56 (* w h 4)))
|
|
||||||
(def mem:p32 (malloc size))
|
|
||||||
(def c:cursor (cast (malloc 4)))
|
|
||||||
#(def cursor_data:p32 mem)
|
|
||||||
#(def c:cursor (address cursor_data))
|
|
||||||
(store c mem)
|
|
||||||
(w16 c 0x4D42) # ascii "BM"
|
|
||||||
(w32 c size)
|
|
||||||
(w32 c 0)
|
|
||||||
(w32 c 56)
|
|
||||||
(w32 c 40)
|
|
||||||
(w32 c w)
|
|
||||||
(w32 c h)
|
|
||||||
(w16 c 1)
|
|
||||||
(w16 c 32)
|
|
||||||
(w32 c 0)
|
|
||||||
(w32 c 0)
|
|
||||||
(w32 c 4096)
|
|
||||||
(w32 c 4096)
|
|
||||||
(w32 c 0)
|
|
||||||
(w32 c 0)
|
|
||||||
(w16 c 0) # padding
|
|
||||||
# Draw
|
|
||||||
(def red:uint 0xFFFF0000)
|
|
||||||
(def blue:uint 0xFF0000FF)
|
|
||||||
(def green:uint 0xFF00FF00)
|
|
||||||
(var y:uint 0)
|
|
||||||
(while (< y h)
|
|
||||||
(var x:uint 0)
|
|
||||||
(while (< x w)
|
|
||||||
(def d2:uint (+ (* x x) (* y y)))
|
|
||||||
(if (> d2 100000)
|
|
||||||
(if (> d2 200000) (w32 c green) (w32 c blue))
|
|
||||||
(w32 c red))
|
|
||||||
(set x (+ 1 x)))
|
|
||||||
(set y (+ y 1)))
|
|
||||||
(write 1 mem size)
|
|
||||||
(return mem))
|
|
||||||
|
|
||||||
(defsys main:int []
|
|
||||||
(def w:uint 512)
|
|
||||||
(def h:uint 512)
|
|
||||||
(makebmp w h)
|
|
||||||
(return 0))
|
|
||||||
|
|
||||||
####
|
|
||||||
|
|
||||||
(dumpx64)
|
|
||||||
|
|
||||||
#(print "#include <unistd.h>")
|
|
||||||
#(dumpc)
|
|
||||||
@@ -1,567 +0,0 @@
|
|||||||
# Make a language frontend for the sysir.
|
|
||||||
# Dialect:
|
|
||||||
# TODO -
|
|
||||||
# * arrays (declaration, loads, stores)
|
|
||||||
|
|
||||||
(defdyn *ret-type* "Current function return type")
|
|
||||||
|
|
||||||
(def slot-to-name @[])
|
|
||||||
(def name-to-slot @{})
|
|
||||||
(def type-to-name @[])
|
|
||||||
(def name-to-type @{})
|
|
||||||
(def slot-types @{})
|
|
||||||
(def functions @{})
|
|
||||||
(def type-fields @{})
|
|
||||||
(def syscalls @{})
|
|
||||||
|
|
||||||
(defn get-slot
|
|
||||||
[&opt new-name]
|
|
||||||
(def next-slot (length slot-to-name))
|
|
||||||
(array/push slot-to-name new-name)
|
|
||||||
(if new-name (put name-to-slot new-name next-slot))
|
|
||||||
next-slot)
|
|
||||||
|
|
||||||
(defn named-slot
|
|
||||||
[name]
|
|
||||||
(assert (get name-to-slot name)))
|
|
||||||
|
|
||||||
(defn make-type
|
|
||||||
[&opt new-name]
|
|
||||||
(def next-type (length type-to-name))
|
|
||||||
(array/push type-to-name new-name)
|
|
||||||
(if new-name (put name-to-type new-name next-type))
|
|
||||||
next-type)
|
|
||||||
|
|
||||||
(defn named-type
|
|
||||||
[name]
|
|
||||||
(def t (get name-to-type name))
|
|
||||||
(assert t)
|
|
||||||
t)
|
|
||||||
|
|
||||||
(defn binding-type
|
|
||||||
[name]
|
|
||||||
(def slot (assert (get name-to-slot name)))
|
|
||||||
(assert (get slot-types slot)))
|
|
||||||
|
|
||||||
(defn slot-type
|
|
||||||
[slot]
|
|
||||||
(assert (get slot-types slot)))
|
|
||||||
|
|
||||||
(defn assign-type
|
|
||||||
[name typ]
|
|
||||||
(def slot (get name-to-slot name))
|
|
||||||
(put slot-types slot typ))
|
|
||||||
|
|
||||||
(defn assign-slot-type
|
|
||||||
[slot typ]
|
|
||||||
(put slot-types slot typ))
|
|
||||||
|
|
||||||
(defn setup-default-types
|
|
||||||
[ctx]
|
|
||||||
(def into @[])
|
|
||||||
(defn add-prim-type
|
|
||||||
[name native-name]
|
|
||||||
(array/push into ~(type-prim ,name ,native-name))
|
|
||||||
(make-type name))
|
|
||||||
(add-prim-type 'float 'f32)
|
|
||||||
(add-prim-type 'double 'f64)
|
|
||||||
(add-prim-type 'int 's32)
|
|
||||||
(add-prim-type 'uint 'u32)
|
|
||||||
(add-prim-type 'long 's64)
|
|
||||||
(add-prim-type 'ulong 'u64)
|
|
||||||
(add-prim-type 'boolean 'boolean)
|
|
||||||
(add-prim-type 's16 's16)
|
|
||||||
(add-prim-type 'u16 'u16)
|
|
||||||
(add-prim-type 'byte 'u8)
|
|
||||||
(add-prim-type 'void 'void)
|
|
||||||
(array/push into ~(type-pointer pointer void))
|
|
||||||
(make-type 'pointer)
|
|
||||||
(sysir/asm ctx into)
|
|
||||||
ctx)
|
|
||||||
|
|
||||||
(defn type-extract
|
|
||||||
"Given a symbol:type combination, extract the proper name and the type separately"
|
|
||||||
[combined-name &opt default-type]
|
|
||||||
(def parts (string/split ":" combined-name 0 2))
|
|
||||||
(def [name tp] parts)
|
|
||||||
[(symbol name) (symbol (or tp default-type))])
|
|
||||||
|
|
||||||
(var do-binop nil)
|
|
||||||
(var do-comp nil)
|
|
||||||
|
|
||||||
###
|
|
||||||
### Inside functions
|
|
||||||
###
|
|
||||||
|
|
||||||
(defn visit1
|
|
||||||
"Take in a form and compile code and put it into `into`. Return result slot."
|
|
||||||
[code into &opt no-return type-hint]
|
|
||||||
(def subresult
|
|
||||||
(cond
|
|
||||||
|
|
||||||
# Compile a constant
|
|
||||||
(string? code) ~(pointer ,code)
|
|
||||||
(boolean? code) ~(boolean ,code)
|
|
||||||
(number? code) ~(,(or type-hint 'double) ,code) # TODO - should default to double
|
|
||||||
|
|
||||||
# Needed?
|
|
||||||
(= :core/u64 (type code)) ~(ulong ,code)
|
|
||||||
(= :core/s64 (type code)) ~(long ,code)
|
|
||||||
|
|
||||||
# Binding
|
|
||||||
(symbol? code)
|
|
||||||
(named-slot code)
|
|
||||||
|
|
||||||
# Array literals
|
|
||||||
(and (tuple? code) (= :brackets (tuple/type code)))
|
|
||||||
(do
|
|
||||||
(assert type-hint (string/format "unknown type for array literal %v" code))
|
|
||||||
~(,type-hint ,code))
|
|
||||||
|
|
||||||
# Compile forms
|
|
||||||
(and (tuple? code) (= :parens (tuple/type code)))
|
|
||||||
(do
|
|
||||||
(assert (> (length code) 0))
|
|
||||||
(def [op & args] code)
|
|
||||||
(case op
|
|
||||||
|
|
||||||
# Arithmetic
|
|
||||||
'+ (do-binop 'add args into type-hint)
|
|
||||||
'- (do-binop 'subtract args into type-hint)
|
|
||||||
'* (do-binop 'multiply args into type-hint)
|
|
||||||
'/ (do-binop 'divide args into type-hint)
|
|
||||||
'<< (do-binop 'shl args into type-hint)
|
|
||||||
'>> (do-binop 'shr args into type-hint)
|
|
||||||
|
|
||||||
# Comparison
|
|
||||||
'= (do-comp 'eq args into)
|
|
||||||
'not= (do-comp 'neq args into)
|
|
||||||
'< (do-comp 'lt args into)
|
|
||||||
'<= (do-comp 'lte args into)
|
|
||||||
'> (do-comp 'gt args into)
|
|
||||||
'>= (do-comp 'gte args into)
|
|
||||||
|
|
||||||
# Pointers
|
|
||||||
'pointer-add
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [base offset] args)
|
|
||||||
(def base-slot (visit1 base into false type-hint))
|
|
||||||
(def offset-slot (visit1 offset into false 'int))
|
|
||||||
(def slot (get-slot))
|
|
||||||
(when type-hint (array/push into ~(bind ,slot ,type-hint)))
|
|
||||||
(array/push into ~(pointer-add ,slot ,base-slot ,offset-slot))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
'pointer-sub
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [base offset] args)
|
|
||||||
(def base-slot (visit1 base into false type-hint))
|
|
||||||
(def offset-slot (visit1 offset into false 'int))
|
|
||||||
(def slot (get-slot))
|
|
||||||
(when type-hint (array/push into ~(bind ,slot ,type-hint)))
|
|
||||||
(array/push into ~(pointer-subtract ,slot ,base-slot ,offset-slot))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
# Type hinting
|
|
||||||
'the
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [xtype x] args)
|
|
||||||
(def result (visit1 x into false xtype))
|
|
||||||
(if (tuple? result) # constant
|
|
||||||
(let [[t y] result]
|
|
||||||
(assertf (= t xtype) "type mismatch, %p doesn't match %p" t xtype)
|
|
||||||
[xtype y])
|
|
||||||
(do
|
|
||||||
(array/push into ~(bind ,result ,xtype))
|
|
||||||
result)))
|
|
||||||
|
|
||||||
# Casting
|
|
||||||
'cast
|
|
||||||
(do
|
|
||||||
(assert (= 1 (length args)))
|
|
||||||
(assert type-hint) # should we add an explicit cast type?
|
|
||||||
(def [x] args)
|
|
||||||
(def slot (get-slot))
|
|
||||||
(def result (visit1 x into false))
|
|
||||||
(array/push into ~(bind ,slot ,type-hint))
|
|
||||||
(array/push into ~(cast ,slot ,result))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
# Named bindings
|
|
||||||
'def
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [full-name value] args)
|
|
||||||
(assert (symbol? full-name))
|
|
||||||
(def [name tp] (type-extract full-name 'int))
|
|
||||||
(def result (visit1 value into false tp))
|
|
||||||
(def slot (get-slot name))
|
|
||||||
(assign-type name tp)
|
|
||||||
(array/push into ~(bind ,slot ,tp))
|
|
||||||
(array/push into ~(move ,slot ,result))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
# Named variables
|
|
||||||
'var
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [full-name value] args)
|
|
||||||
(assert (symbol? full-name))
|
|
||||||
(def [name tp] (type-extract full-name 'int))
|
|
||||||
(def result (visit1 value into false tp))
|
|
||||||
(def slot (get-slot name))
|
|
||||||
(assign-type name tp)
|
|
||||||
(array/push into ~(bind ,slot ,tp))
|
|
||||||
(array/push into ~(move ,slot ,result))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
# Address of (& operator in C)
|
|
||||||
'address
|
|
||||||
(do
|
|
||||||
(assert (= 1 (length args)))
|
|
||||||
(def [thing] args)
|
|
||||||
(def [name tp] (type-extract thing 'int))
|
|
||||||
(def result (visit1 thing into false tp))
|
|
||||||
(def slot (get-slot))
|
|
||||||
#
|
|
||||||
(array/push into ~(bind ,slot ,type-hint))
|
|
||||||
(array/push into ~(address ,slot ,result))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
'load
|
|
||||||
(do
|
|
||||||
(assert (= 1 (length args)))
|
|
||||||
(assert type-hint)
|
|
||||||
(def [thing] args)
|
|
||||||
# (def [name tp] (type-extract thing 'pointer))
|
|
||||||
(def result (visit1 thing into false))
|
|
||||||
(def slot (get-slot))
|
|
||||||
(def ptype type-hint)
|
|
||||||
(array/push into ~(bind ,slot ,ptype))
|
|
||||||
(array/push into ~(load ,slot ,result))
|
|
||||||
slot)
|
|
||||||
|
|
||||||
'store
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [dest value] args)
|
|
||||||
# (def [name tp] (type-extract dest 'pointer))
|
|
||||||
(def dest-r (visit1 dest into false))
|
|
||||||
(def value-r (visit1 value into false))
|
|
||||||
(array/push into ~(store ,dest-r ,value-r))
|
|
||||||
value-r)
|
|
||||||
|
|
||||||
# Assignment
|
|
||||||
'set
|
|
||||||
(do
|
|
||||||
(assert (= 2 (length args)))
|
|
||||||
(def [to x] args)
|
|
||||||
(def type-hint (binding-type to))
|
|
||||||
(def result (visit1 x into false type-hint))
|
|
||||||
(def toslot (named-slot to))
|
|
||||||
(array/push into ~(move ,toslot ,result))
|
|
||||||
toslot)
|
|
||||||
|
|
||||||
# Return
|
|
||||||
'return
|
|
||||||
(do
|
|
||||||
(assert (>= 1 (length args)))
|
|
||||||
(if (empty? args)
|
|
||||||
(array/push into '(return))
|
|
||||||
(do
|
|
||||||
(def [x] args)
|
|
||||||
(array/push into ~(return ,(visit1 x into false (dyn *ret-type*))))))
|
|
||||||
nil)
|
|
||||||
|
|
||||||
# Sequence of operations
|
|
||||||
'do
|
|
||||||
(do
|
|
||||||
(each form (slice args 0 -2) (visit1 form into true))
|
|
||||||
(visit1 (last args) into false type-hint))
|
|
||||||
|
|
||||||
# While loop
|
|
||||||
'while
|
|
||||||
(do
|
|
||||||
(def lab-test (keyword (gensym)))
|
|
||||||
(def lab-exit (keyword (gensym)))
|
|
||||||
(assert (< 1 (length args)))
|
|
||||||
(def [cnd & body] args)
|
|
||||||
(array/push into lab-test)
|
|
||||||
(def condition-slot (visit1 cnd into false 'boolean))
|
|
||||||
(array/push into ~(branch-not ,condition-slot ,lab-exit))
|
|
||||||
(each code body
|
|
||||||
(visit1 code into true))
|
|
||||||
(array/push into ~(jump ,lab-test))
|
|
||||||
(array/push into lab-exit)
|
|
||||||
nil)
|
|
||||||
|
|
||||||
# Branch
|
|
||||||
'if
|
|
||||||
(do
|
|
||||||
(def lab (keyword (gensym)))
|
|
||||||
(def lab-end (keyword (gensym)))
|
|
||||||
(assert (< 2 (length args) 4))
|
|
||||||
(def [cnd tru fal] args)
|
|
||||||
(def condition-slot (visit1 cnd into false 'boolean))
|
|
||||||
(def ret (if type-hint (get-slot)))
|
|
||||||
(when type-hint (array/push into ~(bind ,ret ,type-hint)))
|
|
||||||
(array/push into ~(branch ,condition-slot ,lab))
|
|
||||||
# false path
|
|
||||||
(if type-hint
|
|
||||||
(array/push into ~(move ,ret ,(visit1 fal into false type-hint)))
|
|
||||||
(visit1 fal into true))
|
|
||||||
(array/push into ~(jump ,lab-end))
|
|
||||||
(array/push into lab)
|
|
||||||
# true path
|
|
||||||
(if type-hint
|
|
||||||
(array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
|
|
||||||
(visit1 tru into true))
|
|
||||||
(array/push into lab-end)
|
|
||||||
ret)
|
|
||||||
|
|
||||||
# Insert IR
|
|
||||||
'ir
|
|
||||||
(do
|
|
||||||
(assert no-return)
|
|
||||||
(array/push into ;args)
|
|
||||||
nil)
|
|
||||||
|
|
||||||
# Assume function call or syscall
|
|
||||||
(do
|
|
||||||
(def slots @[])
|
|
||||||
(def signature (get functions op))
|
|
||||||
(def is-syscall (get syscalls op))
|
|
||||||
(assert signature (string "unknown function " op))
|
|
||||||
(def ret (if no-return nil (get-slot)))
|
|
||||||
(when ret
|
|
||||||
(array/push into ~(bind ,ret ,(first signature)))
|
|
||||||
(assign-type ret (first signature)))
|
|
||||||
(each [arg-type arg] (map tuple (drop 1 signature) args)
|
|
||||||
(array/push slots (visit1 arg into false arg-type)))
|
|
||||||
(if is-syscall
|
|
||||||
(array/push into ~(syscall :default ,ret (int ,is-syscall) ,;slots))
|
|
||||||
(array/push into ~(call :default ,ret [pointer ,op] ,;slots)))
|
|
||||||
ret)))
|
|
||||||
|
|
||||||
(errorf "cannot compile %q" code)))
|
|
||||||
|
|
||||||
# Check type-hint matches return type
|
|
||||||
(if type-hint
|
|
||||||
(when-let [t (first subresult)] # TODO - Disallow empty types
|
|
||||||
(assert (= type-hint t) (string/format "%j, expected type %v, got %v" code type-hint t))))
|
|
||||||
|
|
||||||
subresult)
|
|
||||||
|
|
||||||
(varfn do-binop
|
|
||||||
"Emit an operation such as (+ x y).
|
|
||||||
Extended to support any number of arguments such as (+ x y z ...)"
|
|
||||||
[opcode args into type-hint]
|
|
||||||
(var typ type-hint)
|
|
||||||
(var final nil)
|
|
||||||
(def slots @[])
|
|
||||||
(each arg args
|
|
||||||
(def right (visit1 arg into false typ))
|
|
||||||
(when (number? right) (array/push slots right))
|
|
||||||
|
|
||||||
# If we don't have a type hint, infer types from bottom up
|
|
||||||
(when (nil? typ)
|
|
||||||
(when-let [new-typ (get slot-types right)]
|
|
||||||
(set typ new-typ)))
|
|
||||||
|
|
||||||
(set final
|
|
||||||
(if final
|
|
||||||
(let [result (get-slot)]
|
|
||||||
(array/push slots result)
|
|
||||||
(array/push into ~(,opcode ,result ,final ,right))
|
|
||||||
result)
|
|
||||||
right)))
|
|
||||||
(assert typ (string "unable to infer type for %j" [opcode ;args]))
|
|
||||||
(each slot (distinct slots)
|
|
||||||
(array/push into ~(bind ,slot ,typ)))
|
|
||||||
(assert final))
|
|
||||||
|
|
||||||
(varfn do-comp
|
|
||||||
"Emit a comparison form such as (= x y z ...)"
|
|
||||||
[opcode args into]
|
|
||||||
(def result (get-slot))
|
|
||||||
(def needs-temp (> 2 (length args)))
|
|
||||||
(def temp-result (if needs-temp (get-slot) nil))
|
|
||||||
(array/push into ~(bind ,result boolean))
|
|
||||||
(when needs-temp
|
|
||||||
(array/push into ~(bind ,temp-result boolean)))
|
|
||||||
(var left nil)
|
|
||||||
(var first-compare true)
|
|
||||||
(var typ nil)
|
|
||||||
(each arg args
|
|
||||||
(def right (visit1 arg into false typ))
|
|
||||||
# If we don't have a type hint, infer types from bottom up
|
|
||||||
(when (nil? typ)
|
|
||||||
(when-let [new-typ (get slot-types right)]
|
|
||||||
(set typ new-typ)))
|
|
||||||
(when left
|
|
||||||
(if first-compare
|
|
||||||
(array/push into ~(,opcode ,result ,left ,right))
|
|
||||||
(do
|
|
||||||
(array/push into ~(,opcode ,temp-result ,left ,right))
|
|
||||||
(array/push into ~(and ,result ,temp-result ,result))))
|
|
||||||
(set first-compare false))
|
|
||||||
(set left right))
|
|
||||||
result)
|
|
||||||
|
|
||||||
###
|
|
||||||
### Top level
|
|
||||||
###
|
|
||||||
|
|
||||||
(defn top
|
|
||||||
"Visit and emit code for a top level form."
|
|
||||||
[ctx form]
|
|
||||||
(assert (tuple? form))
|
|
||||||
(def [head & rest] form)
|
|
||||||
(case head
|
|
||||||
|
|
||||||
# Declare a struct
|
|
||||||
'defstruct
|
|
||||||
(do
|
|
||||||
(def into @[])
|
|
||||||
(def [name & fields] rest)
|
|
||||||
(assert (even? (length fields)) "expected an even number of fields for struct definition")
|
|
||||||
(def field-types @[])
|
|
||||||
(each [field-name typ] (partition 2 fields)
|
|
||||||
# TODO - don't ignore field names
|
|
||||||
(array/push field-types typ))
|
|
||||||
(array/push into ~(type-struct ,name ,;field-types))
|
|
||||||
# (eprintf "%.99M" into)
|
|
||||||
(sysir/asm ctx into))
|
|
||||||
|
|
||||||
# Declare a union
|
|
||||||
'defunion
|
|
||||||
(do
|
|
||||||
(def into @[])
|
|
||||||
(def [name & fields] rest)
|
|
||||||
(assert (even? (length fields)) "expected an even number of fields for struct definition")
|
|
||||||
(def field-types @[])
|
|
||||||
(each [field-name typ] (partition 2 fields)
|
|
||||||
# TODO - don't ignore field names
|
|
||||||
(array/push field-types typ))
|
|
||||||
(array/push into ~(type-union ,name ,;field-types))
|
|
||||||
# (eprintf "%.99M" into)
|
|
||||||
(sysir/asm ctx into))
|
|
||||||
|
|
||||||
# Declare a pointer type
|
|
||||||
'defpointer
|
|
||||||
(do
|
|
||||||
(def into @[])
|
|
||||||
(def [name element] rest)
|
|
||||||
(def field-types @[])
|
|
||||||
(array/push into ~(type-pointer ,name ,element))
|
|
||||||
# (eprintf "%.99M" into)
|
|
||||||
(sysir/asm ctx into))
|
|
||||||
|
|
||||||
# Declare an array type
|
|
||||||
'defarray
|
|
||||||
(do
|
|
||||||
(def into @[])
|
|
||||||
(def [name element cnt] rest)
|
|
||||||
(assert (and (pos? cnt) (int? cnt)) "expected positive integer for array count")
|
|
||||||
(array/push into ~(type-array ,name ,element ,cnt))
|
|
||||||
# (eprintf "%.99M" into)
|
|
||||||
(sysir/asm ctx into))
|
|
||||||
|
|
||||||
# External function
|
|
||||||
'defn-external
|
|
||||||
(do
|
|
||||||
(def [name args] rest)
|
|
||||||
(assert (tuple? args))
|
|
||||||
(def [fn-name fn-tp] (type-extract name 'void))
|
|
||||||
(def pcount (length args)) #TODO - more complicated signatures
|
|
||||||
(def signature @[fn-tp])
|
|
||||||
(each arg args
|
|
||||||
(def [name tp] (type-extract arg 'int))
|
|
||||||
(array/push signature tp))
|
|
||||||
(put functions fn-name (freeze signature)))
|
|
||||||
|
|
||||||
# External syscall
|
|
||||||
'defn-syscall
|
|
||||||
(do
|
|
||||||
(def [name sysnum args] rest)
|
|
||||||
(assert (tuple? args))
|
|
||||||
(def [fn-name fn-tp] (type-extract name 'void))
|
|
||||||
(def pcount (length args)) #TODO - more complicated signatures
|
|
||||||
(def signature @[fn-tp])
|
|
||||||
(each arg args
|
|
||||||
(def [name tp] (type-extract arg 'int))
|
|
||||||
(array/push signature tp))
|
|
||||||
(put syscalls fn-name sysnum)
|
|
||||||
(put functions fn-name (freeze signature)))
|
|
||||||
|
|
||||||
# Top level function definition
|
|
||||||
'defn
|
|
||||||
(do
|
|
||||||
# TODO doc strings
|
|
||||||
(table/clear name-to-slot)
|
|
||||||
(table/clear slot-types)
|
|
||||||
(array/clear slot-to-name)
|
|
||||||
(def [name args & body] rest)
|
|
||||||
(assert (tuple? args))
|
|
||||||
(def [fn-name fn-tp] (type-extract name 'void))
|
|
||||||
(def pcount (length args)) #TODO - more complicated signatures
|
|
||||||
(def ir-asm
|
|
||||||
@[~(link-name ,(string fn-name))
|
|
||||||
~(parameter-count ,pcount)])
|
|
||||||
(def signature @[fn-tp])
|
|
||||||
(each arg args
|
|
||||||
(def [name tp] (type-extract arg 'int))
|
|
||||||
(def slot (get-slot name))
|
|
||||||
(assign-type name tp)
|
|
||||||
(array/push signature tp)
|
|
||||||
(array/push ir-asm ~(bind ,slot ,tp)))
|
|
||||||
(with-dyns [*ret-type* fn-tp]
|
|
||||||
(each part body
|
|
||||||
(visit1 part ir-asm true)))
|
|
||||||
(put functions fn-name (freeze signature))
|
|
||||||
(when (dyn :verbose) (eprintf "%.99M" ir-asm))
|
|
||||||
(sysir/asm ctx ir-asm))
|
|
||||||
|
|
||||||
(errorf "unknown form %p" form)))
|
|
||||||
|
|
||||||
###
|
|
||||||
### Setup
|
|
||||||
###
|
|
||||||
|
|
||||||
(def ctx (sysir/context))
|
|
||||||
(setup-default-types ctx)
|
|
||||||
|
|
||||||
(defn compile1
|
|
||||||
[x]
|
|
||||||
(top ctx x))
|
|
||||||
|
|
||||||
(defn dump
|
|
||||||
[]
|
|
||||||
(eprintf "%.99M\n" (sysir/to-ir ctx)))
|
|
||||||
|
|
||||||
(defn dumpx64
|
|
||||||
[]
|
|
||||||
(print (sysir/to-x64 ctx)))
|
|
||||||
|
|
||||||
(defn dumpx64-windows
|
|
||||||
[]
|
|
||||||
(print (sysir/to-x64 ctx @"" :windows)))
|
|
||||||
|
|
||||||
(defn dumpc
|
|
||||||
[]
|
|
||||||
(print (sysir/to-c ctx)))
|
|
||||||
|
|
||||||
###
|
|
||||||
### Top Level aliases
|
|
||||||
###
|
|
||||||
|
|
||||||
(defmacro defstruct [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defstruct ,;args))])
|
|
||||||
(defmacro defunion [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defunion ,;args))])
|
|
||||||
(defmacro defarray [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defarray ,;args))])
|
|
||||||
(defmacro defpointer [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defpointer ,;args))])
|
|
||||||
(defmacro defn-external [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-external ,;args))])
|
|
||||||
(defmacro defn-syscall [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-syscall ,;args))])
|
|
||||||
(defmacro defsys [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn ,;args))])
|
|
||||||
@@ -1,16 +0,0 @@
|
|||||||
(use ./frontend)
|
|
||||||
|
|
||||||
(defn-external printf:int [fmt:pointer])
|
|
||||||
(defn-external exit:void [x:int])
|
|
||||||
|
|
||||||
(defsys _start:void []
|
|
||||||
(printf "hello, world!\n")
|
|
||||||
(exit (the int 0))
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defn main [& args]
|
|
||||||
(def [_ what] args)
|
|
||||||
(eprint "MODE: " what)
|
|
||||||
(case what
|
|
||||||
"c" (dumpc)
|
|
||||||
"x64" (dumpx64)))
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
#!/usr/bin/env bash
|
|
||||||
valgrind build/janet examples/sysir/drawing.janet > temp.c
|
|
||||||
cc temp.c
|
|
||||||
./a.out > temp.bmp
|
|
||||||
feh temp.bmp
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
#!/usr/bin/env bash
|
|
||||||
valgrind build/janet examples/sysir/drawing2.janet > temp.nasm
|
|
||||||
nasm -felf64 temp.nasm -l temp.lst -o temp.o
|
|
||||||
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
|
|
||||||
valgrind ./temp.bin
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
janet.exe examples/sysir/windows_samples.janet > temp.nasm
|
|
||||||
nasm -fwin64 temp.nasm -l temp.lst -o temp.o
|
|
||||||
link /entry:Start /subsystem:windows kernel32.lib user32.lib temp.o /out:temp.exe
|
|
||||||
temp.exe
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
#!/usr/bin/env bash
|
|
||||||
valgrind build/janet examples/sysir/samples.janet > temp.nasm
|
|
||||||
nasm -felf64 temp.nasm -l temp.lst -o temp.o
|
|
||||||
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
|
|
||||||
valgrind ./temp.bin
|
|
||||||
@@ -1,72 +0,0 @@
|
|||||||
(use ./frontend)
|
|
||||||
|
|
||||||
(defstruct vec3
|
|
||||||
a float
|
|
||||||
b float
|
|
||||||
c float)
|
|
||||||
|
|
||||||
(defunion myunion
|
|
||||||
a float
|
|
||||||
b double
|
|
||||||
c long)
|
|
||||||
|
|
||||||
(defarray myvec float 4)
|
|
||||||
(defarray mymat myvec 4)
|
|
||||||
|
|
||||||
(defn-external printf:int [fmt:pointer x:int]) # TODO varargs
|
|
||||||
|
|
||||||
(defn-external exit:void [x:int])
|
|
||||||
|
|
||||||
(defsys square:int
|
|
||||||
[num:int]
|
|
||||||
(return (* 1 num num)))
|
|
||||||
|
|
||||||
(defsys simple:int [x:int]
|
|
||||||
(def xyz:int (+ 1 2 3))
|
|
||||||
(return (* x 2 x)))
|
|
||||||
|
|
||||||
(defsys myprog:int []
|
|
||||||
(def xyz:int (+ 1 2 3))
|
|
||||||
(def abc:int (* 4 5 6))
|
|
||||||
(def x:boolean (= xyz 5))
|
|
||||||
(var i:int 0)
|
|
||||||
(while (< i 10)
|
|
||||||
(set i (+ 1 i))
|
|
||||||
(printf "i = %d\n" i))
|
|
||||||
(printf "hello, world!\n%d\n" (if x abc xyz))
|
|
||||||
(return (simple (* abc xyz))))
|
|
||||||
|
|
||||||
(defsys doloop [x:int y:int]
|
|
||||||
(var i:int x)
|
|
||||||
(while (< i y)
|
|
||||||
(set i (+ 1 i))
|
|
||||||
(printf "i = %d\n" i))
|
|
||||||
(myprog)
|
|
||||||
(return x))
|
|
||||||
|
|
||||||
(defsys _start:void []
|
|
||||||
#(syscall 1 1 "Hello, world!\n" 14)
|
|
||||||
(doloop 10 20)
|
|
||||||
(exit (the int 0))
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defsys test_inttypes:ulong []
|
|
||||||
(def x:ulong 123:u)
|
|
||||||
(return (+ x x)))
|
|
||||||
|
|
||||||
(defsys test_arrays:myvec [a:myvec b:myvec]
|
|
||||||
(return (+ a b)))
|
|
||||||
|
|
||||||
'(defsys make_array:myvec []
|
|
||||||
(def vec:myvec [0 0 0 0])
|
|
||||||
(return vec))
|
|
||||||
|
|
||||||
'(defsys make_mat:mymat []
|
|
||||||
(def mat:mymat [[1 0 0 0] [0 1 0 0] [0 0 1 0] [0 0 0 1]])
|
|
||||||
(return mat))
|
|
||||||
|
|
||||||
####
|
|
||||||
|
|
||||||
#(dump)
|
|
||||||
#(dumpc)
|
|
||||||
(dumpx64)
|
|
||||||
@@ -1,10 +0,0 @@
|
|||||||
(def ir-asm
|
|
||||||
'((link-name "redefine_type_fail")
|
|
||||||
(type-prim Real f32)
|
|
||||||
(type-prim 1 s32)
|
|
||||||
(bind bob Real)
|
|
||||||
(return bob)))
|
|
||||||
|
|
||||||
(def ctx (sysir/context))
|
|
||||||
(sysir/asm ctx ir-asm)
|
|
||||||
(print (sysir/to-c ctx))
|
|
||||||
@@ -1,14 +0,0 @@
|
|||||||
(use ./frontend)
|
|
||||||
|
|
||||||
(def winmain
|
|
||||||
'(defn Start:void []
|
|
||||||
(MessageBoxExA (the pointer 0) "Hello, world!" "Test" 0 (the s16 0))
|
|
||||||
(ExitProcess (the int 0))
|
|
||||||
(return)))
|
|
||||||
|
|
||||||
####
|
|
||||||
|
|
||||||
(compile1 winmain)
|
|
||||||
#(dump)
|
|
||||||
#(dumpc)
|
|
||||||
(dumpx64-windows)
|
|
||||||
@@ -1,24 +0,0 @@
|
|||||||
(use ./frontend)
|
|
||||||
|
|
||||||
(defn-external printf:int [fmt:pointer x:int])
|
|
||||||
(defn-external exit:void [x:int])
|
|
||||||
|
|
||||||
(defsys doloop [x:int y:int]
|
|
||||||
(var i:int x)
|
|
||||||
(printf "initial i = %d\n" i)
|
|
||||||
(while (< i y)
|
|
||||||
(set i (+ 1 i))
|
|
||||||
(printf "i = %d\n" i))
|
|
||||||
(return x))
|
|
||||||
|
|
||||||
(defsys _start:void []
|
|
||||||
(doloop 10 20)
|
|
||||||
(exit (the int 0))
|
|
||||||
(return))
|
|
||||||
|
|
||||||
(defn main [& args]
|
|
||||||
(def [_ what] args)
|
|
||||||
(eprint "MODE: " what)
|
|
||||||
(case what
|
|
||||||
"c" (dumpc)
|
|
||||||
"x64" (dumpx64)))
|
|
||||||
@@ -126,8 +126,7 @@ core_headers = [
|
|||||||
'src/core/regalloc.h',
|
'src/core/regalloc.h',
|
||||||
'src/core/compile.h',
|
'src/core/compile.h',
|
||||||
'src/core/emit.h',
|
'src/core/emit.h',
|
||||||
'src/core/symcache.h',
|
'src/core/symcache.h'
|
||||||
'src/core/sysir.h',
|
|
||||||
]
|
]
|
||||||
|
|
||||||
core_src = [
|
core_src = [
|
||||||
@@ -164,9 +163,6 @@ core_src = [
|
|||||||
'src/core/strtod.c',
|
'src/core/strtod.c',
|
||||||
'src/core/struct.c',
|
'src/core/struct.c',
|
||||||
'src/core/symcache.c',
|
'src/core/symcache.c',
|
||||||
'src/core/sysir.c',
|
|
||||||
'src/core/sysir_c.c',
|
|
||||||
'src/core/sysir_x86.c',
|
|
||||||
'src/core/table.c',
|
'src/core/table.c',
|
||||||
'src/core/tuple.c',
|
'src/core/tuple.c',
|
||||||
'src/core/util.c',
|
'src/core/util.c',
|
||||||
@@ -301,7 +297,6 @@ test_files = [
|
|||||||
'test/suite-strtod.janet',
|
'test/suite-strtod.janet',
|
||||||
'test/suite-struct.janet',
|
'test/suite-struct.janet',
|
||||||
'test/suite-symcache.janet',
|
'test/suite-symcache.janet',
|
||||||
'test/suite-sysir.janet',
|
|
||||||
'test/suite-table.janet',
|
'test/suite-table.janet',
|
||||||
'test/suite-tuple.janet',
|
'test/suite-tuple.janet',
|
||||||
'test/suite-unknown.janet',
|
'test/suite-unknown.janet',
|
||||||
|
|||||||
@@ -7,7 +7,7 @@
|
|||||||
###
|
###
|
||||||
###
|
###
|
||||||
|
|
||||||
(def defn :macro :flycheck
|
(def defn :macro
|
||||||
```
|
```
|
||||||
(defn name & more)
|
(defn name & more)
|
||||||
|
|
||||||
@@ -43,7 +43,7 @@
|
|||||||
# Build return value
|
# Build return value
|
||||||
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
|
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
|
||||||
|
|
||||||
(defn defmacro :macro :flycheck
|
(defn defmacro :macro
|
||||||
"Define a macro."
|
"Define a macro."
|
||||||
[name & more]
|
[name & more]
|
||||||
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
|
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
|
||||||
@@ -57,12 +57,12 @@
|
|||||||
[f & args]
|
[f & args]
|
||||||
(f ;args))
|
(f ;args))
|
||||||
|
|
||||||
(defmacro defmacro- :flycheck
|
(defmacro defmacro-
|
||||||
"Define a private macro that will not be exported."
|
"Define a private macro that will not be exported."
|
||||||
[name & more]
|
[name & more]
|
||||||
(apply defn name :macro :private more))
|
(apply defn name :macro :private more))
|
||||||
|
|
||||||
(defmacro defn- :flycheck
|
(defmacro defn-
|
||||||
"Define a private function that will not be exported."
|
"Define a private function that will not be exported."
|
||||||
[name & more]
|
[name & more]
|
||||||
(apply defn name :private more))
|
(apply defn name :private more))
|
||||||
@@ -144,7 +144,7 @@
|
|||||||
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
|
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
|
||||||
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
|
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
|
||||||
|
|
||||||
(defmacro assert :flycheck # should top level assert flycheck?
|
(defmacro assert
|
||||||
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
|
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
|
||||||
[x &opt err]
|
[x &opt err]
|
||||||
(def v (gensym))
|
(def v (gensym))
|
||||||
@@ -154,7 +154,7 @@
|
|||||||
,v
|
,v
|
||||||
(,error ,(if err err (string/format "assert failure in %j" x))))))
|
(,error ,(if err err (string/format "assert failure in %j" x))))))
|
||||||
|
|
||||||
(defmacro defdyn :flycheck
|
(defmacro defdyn
|
||||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||||
alias is a normal, lexically scoped binding that can be used instead of
|
alias is a normal, lexically scoped binding that can be used instead of
|
||||||
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
|
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
|
||||||
@@ -171,9 +171,6 @@
|
|||||||
(defdyn *macro-form*
|
(defdyn *macro-form*
|
||||||
"Inside a macro, is bound to the source form that invoked the macro")
|
"Inside a macro, is bound to the source form that invoked the macro")
|
||||||
|
|
||||||
(defdyn *flychecking*
|
|
||||||
"Check if the current form is being evaluated inside `flycheck`. Will be `true` while flychecking.")
|
|
||||||
|
|
||||||
(defdyn *lint-error*
|
(defdyn *lint-error*
|
||||||
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
|
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
|
||||||
|
|
||||||
@@ -2292,8 +2289,8 @@
|
|||||||
|
|
||||||
(defn thaw
|
(defn thaw
|
||||||
`Thaw an object (make it mutable) and do a deep copy, making
|
`Thaw an object (make it mutable) and do a deep copy, making
|
||||||
child values also mutable. Closures, fibers, and abstract
|
child value also mutable. Closures, fibers, and abstract
|
||||||
types will not be recursively thawed, but all other types will.`
|
types will not be recursively thawed, but all other types will`
|
||||||
[ds]
|
[ds]
|
||||||
(case (type ds)
|
(case (type ds)
|
||||||
:array (walk-ind thaw ds)
|
:array (walk-ind thaw ds)
|
||||||
@@ -2357,7 +2354,7 @@
|
|||||||
|
|
||||||
(set macexvar macex)
|
(set macexvar macex)
|
||||||
|
|
||||||
(defmacro varfn :flycheck
|
(defmacro varfn
|
||||||
``Create a function that can be rebound. `varfn` has the same signature
|
``Create a function that can be rebound. `varfn` has the same signature
|
||||||
as `defn`, but defines functions in the environment as vars. If a var `name`
|
as `defn`, but defines functions in the environment as vars. If a var `name`
|
||||||
already exists in the environment, it is rebound to the new function. Returns
|
already exists in the environment, it is rebound to the new function. Returns
|
||||||
@@ -3948,7 +3945,7 @@
|
|||||||
[& forms]
|
[& forms]
|
||||||
(def state (gensym))
|
(def state (gensym))
|
||||||
(def loaded (gensym))
|
(def loaded (gensym))
|
||||||
~((fn :delay []
|
~((fn []
|
||||||
(var ,state nil)
|
(var ,state nil)
|
||||||
(var ,loaded nil)
|
(var ,loaded nil)
|
||||||
(fn []
|
(fn []
|
||||||
@@ -3980,7 +3977,7 @@
|
|||||||
:lazy lazy
|
:lazy lazy
|
||||||
:map-symbols map-symbols}))
|
:map-symbols map-symbols}))
|
||||||
|
|
||||||
(defmacro ffi/defbind-alias :flycheck
|
(defmacro ffi/defbind-alias
|
||||||
"Generate bindings for native functions in a convenient manner.
|
"Generate bindings for native functions in a convenient manner.
|
||||||
Similar to defbind but allows for the janet function name to be
|
Similar to defbind but allows for the janet function name to be
|
||||||
different than the FFI function."
|
different than the FFI function."
|
||||||
@@ -3991,8 +3988,6 @@
|
|||||||
(def formal-args (map 0 arg-pairs))
|
(def formal-args (map 0 arg-pairs))
|
||||||
(def type-args (map 1 arg-pairs))
|
(def type-args (map 1 arg-pairs))
|
||||||
(def computed-type-args (eval ~[,;type-args]))
|
(def computed-type-args (eval ~[,;type-args]))
|
||||||
(if (dyn *flychecking*)
|
|
||||||
(break ~(defn ,alias ,;meta [,;formal-args] nil)))
|
|
||||||
(def {:native lib
|
(def {:native lib
|
||||||
:lazy lazy
|
:lazy lazy
|
||||||
:native-lazy llib
|
:native-lazy llib
|
||||||
@@ -4008,7 +4003,7 @@
|
|||||||
~(defn ,alias ,;meta [,;formal-args]
|
~(defn ,alias ,;meta [,;formal-args]
|
||||||
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
|
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
|
||||||
|
|
||||||
(defmacro ffi/defbind :flycheck
|
(defmacro ffi/defbind
|
||||||
"Generate bindings for native functions in a convenient manner."
|
"Generate bindings for native functions in a convenient manner."
|
||||||
[name ret-type & body]
|
[name ret-type & body]
|
||||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
||||||
@@ -4019,51 +4014,6 @@
|
|||||||
###
|
###
|
||||||
###
|
###
|
||||||
|
|
||||||
(def- flycheck-specials @{})
|
|
||||||
|
|
||||||
(defn- flycheck-evaluator
|
|
||||||
``
|
|
||||||
An evaluator function that is passed to `run-context` that lints
|
|
||||||
(flychecks) code for `flycheck`. This means code will be parsed,
|
|
||||||
compiled, and have macros expanded, but the code will not be
|
|
||||||
evaluated.
|
|
||||||
``
|
|
||||||
[thunk source env where]
|
|
||||||
(when (and (tuple? source) (= (tuple/type source) :parens))
|
|
||||||
(def head (source 0))
|
|
||||||
(def entry (get env head {}))
|
|
||||||
(def fc (get flycheck-specials head (get entry :flycheck)))
|
|
||||||
(cond
|
|
||||||
# Sometimes safe form
|
|
||||||
(function? fc)
|
|
||||||
(fc thunk source env where)
|
|
||||||
# Always safe form
|
|
||||||
fc
|
|
||||||
(thunk))))
|
|
||||||
|
|
||||||
(defn flycheck
|
|
||||||
```
|
|
||||||
Check a file for errors without running the file. Found errors
|
|
||||||
will be printed to stderr in the usual format. Top level functions
|
|
||||||
and macros that have the metadata `:flycheck` will also be evaluated
|
|
||||||
during flychecking. For full control, the `:flycheck` metadata can
|
|
||||||
also be a function that takes 4 arguments - `thunk`, `source`, `env`,
|
|
||||||
and `where`, the same as the `:evaluator` argument to `run-context`.
|
|
||||||
Other arguments to `flycheck` are the same as `dofile`. Returns nil.
|
|
||||||
```
|
|
||||||
[path &keys kwargs]
|
|
||||||
(def mc @{})
|
|
||||||
(def new-env (make-env (get kwargs :env)))
|
|
||||||
(put new-env *flychecking* true)
|
|
||||||
(put new-env *module-cache* @{})
|
|
||||||
(put new-env *module-loading* @{})
|
|
||||||
(put new-env *module-make-env* (fn :make-flycheck-env [&] (make-env new-env)))
|
|
||||||
(try
|
|
||||||
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs) :env new-env)
|
|
||||||
([e f]
|
|
||||||
(debug/stacktrace f e "")))
|
|
||||||
nil)
|
|
||||||
|
|
||||||
(defn- no-side-effects
|
(defn- no-side-effects
|
||||||
`Check if form may have side effects. If returns true, then the src
|
`Check if form may have side effects. If returns true, then the src
|
||||||
must not have side effects, such as calling a C function.`
|
must not have side effects, such as calling a C function.`
|
||||||
@@ -4079,29 +4029,59 @@
|
|||||||
(all no-side-effects (values src)))
|
(all no-side-effects (values src)))
|
||||||
true))
|
true))
|
||||||
|
|
||||||
(defn- is-safe-def [thunk source env where]
|
(defn- is-safe-def [x] (no-side-effects (last x)))
|
||||||
(if (no-side-effects (last source))
|
|
||||||
(thunk)))
|
|
||||||
|
|
||||||
(defn- flycheck-importer
|
(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true
|
||||||
|
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
|
||||||
|
'defglobal is-safe-def 'varglobal is-safe-def 'defdyn true})
|
||||||
|
|
||||||
|
(def- importers {'import true 'import* true 'dofile true 'require true})
|
||||||
|
(defn- use-2 [evaluator args]
|
||||||
|
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
|
||||||
|
|
||||||
|
(defn- flycheck-evaluator
|
||||||
|
``An evaluator function that is passed to `run-context` that lints (flychecks) code.
|
||||||
|
This means code will parsed and compiled, macros executed, but the code will not be run.
|
||||||
|
Used by `flycheck`.``
|
||||||
[thunk source env where]
|
[thunk source env where]
|
||||||
|
(when (tuple? source)
|
||||||
|
(def head (source 0))
|
||||||
|
(def safe-check
|
||||||
|
(or
|
||||||
|
(safe-forms head)
|
||||||
|
(if (symbol? head)
|
||||||
|
(if (string/has-prefix? "define-" head) is-safe-def))))
|
||||||
|
(cond
|
||||||
|
# Sometimes safe form
|
||||||
|
(function? safe-check)
|
||||||
|
(if (safe-check source) (thunk))
|
||||||
|
# Always safe form
|
||||||
|
safe-check
|
||||||
|
(thunk)
|
||||||
|
# Use
|
||||||
|
(= 'use head)
|
||||||
|
(use-2 flycheck-evaluator (tuple/slice source 1))
|
||||||
|
# Import-like form
|
||||||
|
(importers head)
|
||||||
(let [[l c] (tuple/sourcemap source)
|
(let [[l c] (tuple/sourcemap source)
|
||||||
newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
|
newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
|
||||||
((compile newtup env where))))
|
((compile newtup env where))))))
|
||||||
|
|
||||||
(defn- flycheck-use
|
(defn flycheck
|
||||||
[thunk source env where]
|
``Check a file for errors without running the file. Found errors will be printed to stderr
|
||||||
(each a (drop 1 source) (import* (string a) :prefix "" :evaluator flycheck-evaluator)))
|
in the usual format. Macros will still be executed, however, so
|
||||||
|
arbitrary execution is possible. Other arguments are the same as `dofile`. `path` can also be
|
||||||
# Add metadata to defs and import macros for flychecking
|
a file value such as stdin. Returns nil.``
|
||||||
(each sym ['def 'var]
|
[path &keys kwargs]
|
||||||
(put flycheck-specials sym is-safe-def))
|
(def old-modcache (table/clone module/cache))
|
||||||
(each sym ['def- 'var- 'defglobal 'varglobal]
|
(table/clear module/cache)
|
||||||
(put (dyn sym) :flycheck is-safe-def))
|
(try
|
||||||
(each sym ['import 'import* 'dofile 'require]
|
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
|
||||||
(put (dyn sym) :flycheck flycheck-importer))
|
([e f]
|
||||||
(each sym ['use]
|
(debug/stacktrace f e "")))
|
||||||
(put (dyn sym) :flycheck flycheck-use))
|
(table/clear module/cache)
|
||||||
|
(merge-into module/cache old-modcache)
|
||||||
|
nil)
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@@ -4865,8 +4845,7 @@
|
|||||||
"src/core/regalloc.h"
|
"src/core/regalloc.h"
|
||||||
"src/core/compile.h"
|
"src/core/compile.h"
|
||||||
"src/core/emit.h"
|
"src/core/emit.h"
|
||||||
"src/core/symcache.h"
|
"src/core/symcache.h"])
|
||||||
"src/core/sysir.h"])
|
|
||||||
|
|
||||||
(def core-sources
|
(def core-sources
|
||||||
["src/core/abstract.c"
|
["src/core/abstract.c"
|
||||||
@@ -4902,9 +4881,6 @@
|
|||||||
"src/core/strtod.c"
|
"src/core/strtod.c"
|
||||||
"src/core/struct.c"
|
"src/core/struct.c"
|
||||||
"src/core/symcache.c"
|
"src/core/symcache.c"
|
||||||
"src/core/sysir.c"
|
|
||||||
"src/core/sysir_c.c"
|
|
||||||
"src/core/sysir_x86.c"
|
|
||||||
"src/core/table.c"
|
"src/core/table.c"
|
||||||
"src/core/tuple.c"
|
"src/core/tuple.c"
|
||||||
"src/core/util.c"
|
"src/core/util.c"
|
||||||
|
|||||||
@@ -88,7 +88,7 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
|
|||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
|
||||||
size_t janet_os_mutex_size(void) {
|
size_t janet_os_mutex_size(void) {
|
||||||
return sizeof(CRITICAL_SECTION);
|
return sizeof(SRWLOCK);
|
||||||
}
|
}
|
||||||
|
|
||||||
size_t janet_os_rwlock_size(void) {
|
size_t janet_os_rwlock_size(void) {
|
||||||
@@ -96,20 +96,20 @@ size_t janet_os_rwlock_size(void) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||||
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
|
InitializeSRWLock((PSRWLOCK) mutex);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
||||||
DeleteCriticalSection((CRITICAL_SECTION *) mutex);
|
/* no op? */
|
||||||
|
(void) mutex;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
||||||
EnterCriticalSection((CRITICAL_SECTION *) mutex);
|
AcquireSRWLockExclusive((PSRWLOCK) mutex);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||||
/* error handling? May want to keep counter */
|
ReleaseSRWLockExclusive((PSRWLOCK) mutex);
|
||||||
LeaveCriticalSection((CRITICAL_SECTION *) mutex);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||||
@@ -164,7 +164,7 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
|||||||
|
|
||||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
||||||
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
|
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
|
||||||
if (ret) janet_panicf("cannot release lock: %s", strerror(ret));
|
if (ret) janet_panic("cannot release lock");
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
||||||
|
|||||||
@@ -1127,5 +1127,4 @@ void janet_lib_compile(JanetTable *env) {
|
|||||||
JANET_REG_END
|
JANET_REG_END
|
||||||
};
|
};
|
||||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||||
janet_lib_sysir(env);
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -268,9 +268,6 @@ JanetSlot janetc_cslot(Janet x);
|
|||||||
/* Search for a symbol */
|
/* Search for a symbol */
|
||||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||||
|
|
||||||
/* Load the system dialect IR */
|
|
||||||
void janet_lib_sysir(JanetTable *env);
|
|
||||||
|
|
||||||
/* Bytecode optimization */
|
/* Bytecode optimization */
|
||||||
void janet_bytecode_movopt(JanetFuncDef *def);
|
void janet_bytecode_movopt(JanetFuncDef *def);
|
||||||
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
||||||
|
|||||||
@@ -746,7 +746,6 @@ typedef struct SandboxOption {
|
|||||||
|
|
||||||
static const SandboxOption sandbox_options[] = {
|
static const SandboxOption sandbox_options[] = {
|
||||||
{"all", JANET_SANDBOX_ALL},
|
{"all", JANET_SANDBOX_ALL},
|
||||||
{"chroot", JANET_SANDBOX_CHROOT},
|
|
||||||
{"env", JANET_SANDBOX_ENV},
|
{"env", JANET_SANDBOX_ENV},
|
||||||
{"ffi", JANET_SANDBOX_FFI},
|
{"ffi", JANET_SANDBOX_FFI},
|
||||||
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
||||||
@@ -772,7 +771,6 @@ JANET_CORE_FN(janet_core_sandbox,
|
|||||||
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
||||||
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
||||||
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
||||||
"* :chroot - disallow calling `os/posix-chroot`\n"
|
|
||||||
"* :env - disallow reading and write env variables\n"
|
"* :env - disallow reading and write env variables\n"
|
||||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||||
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
||||||
|
|||||||
@@ -83,7 +83,7 @@ struct JanetChannel {
|
|||||||
int closed;
|
int closed;
|
||||||
int is_threaded;
|
int is_threaded;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
CRITICAL_SECTION lock;
|
SRWLOCK lock;
|
||||||
#else
|
#else
|
||||||
pthread_mutex_t lock;
|
pthread_mutex_t lock;
|
||||||
#endif
|
#endif
|
||||||
@@ -117,9 +117,6 @@ typedef struct {
|
|||||||
double sec;
|
double sec;
|
||||||
JanetVM *vm;
|
JanetVM *vm;
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
HANDLE cancel_event;
|
|
||||||
#endif
|
|
||||||
} JanetThreadedTimeout;
|
} JanetThreadedTimeout;
|
||||||
|
|
||||||
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF
|
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF
|
||||||
@@ -607,7 +604,12 @@ void janet_ev_init_common(void) {
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
#if JANET_ANDROID
|
#ifdef JANET_WINDOWS
|
||||||
|
static VOID CALLBACK janet_timeout_stop(ULONG_PTR ptr) {
|
||||||
|
UNREFERENCED_PARAMETER(ptr);
|
||||||
|
ExitThread(0);
|
||||||
|
}
|
||||||
|
#elif JANET_ANDROID
|
||||||
static void janet_timeout_stop(int sig_num) {
|
static void janet_timeout_stop(int sig_num) {
|
||||||
if (sig_num == SIGUSR1) {
|
if (sig_num == SIGUSR1) {
|
||||||
pthread_exit(0);
|
pthread_exit(0);
|
||||||
@@ -618,14 +620,10 @@ static void janet_timeout_stop(int sig_num) {
|
|||||||
static void handle_timeout_worker(JanetTimeout to, int cancel) {
|
static void handle_timeout_worker(JanetTimeout to, int cancel) {
|
||||||
if (!to.has_worker) return;
|
if (!to.has_worker) return;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
if (cancel && to.worker_event) {
|
(void) cancel;
|
||||||
SetEvent(to.worker_event);
|
QueueUserAPC(janet_timeout_stop, to.worker, 0);
|
||||||
}
|
|
||||||
WaitForSingleObject(to.worker, INFINITE);
|
WaitForSingleObject(to.worker, INFINITE);
|
||||||
CloseHandle(to.worker);
|
CloseHandle(to.worker);
|
||||||
if (to.worker_event) {
|
|
||||||
CloseHandle(to.worker_event);
|
|
||||||
}
|
|
||||||
#else
|
#else
|
||||||
#ifdef JANET_ANDROID
|
#ifdef JANET_ANDROID
|
||||||
if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill");
|
if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill");
|
||||||
@@ -695,20 +693,10 @@ static void janet_timeout_cb(JanetEVGenericMessage msg) {
|
|||||||
static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
|
static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
|
||||||
JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
|
JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
|
||||||
janet_free(ptr);
|
janet_free(ptr);
|
||||||
JanetTimestamp wait_begin = ts_now();
|
SleepEx((DWORD)(tto.sec * 1000), TRUE);
|
||||||
DWORD duration = (DWORD)round(tto.sec * 1000);
|
|
||||||
DWORD res = WAIT_TIMEOUT;
|
|
||||||
JanetTimestamp wait_end = ts_now();
|
|
||||||
for (size_t i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
|
|
||||||
res = WaitForSingleObject(tto.cancel_event, (duration + i));
|
|
||||||
wait_end = ts_now();
|
|
||||||
}
|
|
||||||
/* only send interrupt message if result is WAIT_TIMEOUT */
|
|
||||||
if (res == WAIT_TIMEOUT) {
|
|
||||||
janet_interpreter_interrupt(tto.vm);
|
janet_interpreter_interrupt(tto.vm);
|
||||||
JanetEVGenericMessage msg = {0};
|
JanetEVGenericMessage msg = {0};
|
||||||
janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
|
janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
|
||||||
}
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
@@ -3282,13 +3270,7 @@ JANET_CORE_FN(cfun_ev_deadline,
|
|||||||
tto->vm = &janet_vm;
|
tto->vm = &janet_vm;
|
||||||
tto->fiber = tocheck;
|
tto->fiber = tocheck;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
HANDLE cancel_event = CreateEvent(NULL, TRUE, FALSE, NULL);
|
HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, 0, NULL);
|
||||||
if (NULL == cancel_event) {
|
|
||||||
janet_free(tto);
|
|
||||||
janet_panic("failed to create cancel event");
|
|
||||||
}
|
|
||||||
tto->cancel_event = cancel_event;
|
|
||||||
HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, CREATE_SUSPENDED, NULL);
|
|
||||||
if (NULL == worker) {
|
if (NULL == worker) {
|
||||||
janet_free(tto);
|
janet_free(tto);
|
||||||
janet_panic("failed to create thread");
|
janet_panic("failed to create thread");
|
||||||
@@ -3303,10 +3285,6 @@ JANET_CORE_FN(cfun_ev_deadline,
|
|||||||
#endif
|
#endif
|
||||||
to.has_worker = 1;
|
to.has_worker = 1;
|
||||||
to.worker = worker;
|
to.worker = worker;
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
to.worker_event = cancel_event;
|
|
||||||
ResumeThread(worker);
|
|
||||||
#endif
|
|
||||||
} else {
|
} else {
|
||||||
to.has_worker = 0;
|
to.has_worker = 0;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Mark only the keys from a sequence of key-value pairs */
|
/* Mark a bunch of key values items in memory */
|
||||||
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
||||||
const JanetKV *end = kvs + n;
|
const JanetKV *end = kvs + n;
|
||||||
while (kvs < end) {
|
while (kvs < end) {
|
||||||
@@ -141,7 +141,7 @@ static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Mark only the values from a sequence of key-value pairs */
|
/* Mark a bunch of key values items in memory */
|
||||||
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
||||||
const JanetKV *end = kvs + n;
|
const JanetKV *end = kvs + n;
|
||||||
while (kvs < end) {
|
while (kvs < end) {
|
||||||
@@ -150,7 +150,7 @@ static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Mark key-value pairs */
|
/* Mark a bunch of key values items in memory */
|
||||||
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
||||||
const JanetKV *end = kvs + n;
|
const JanetKV *end = kvs + n;
|
||||||
while (kvs < end) {
|
while (kvs < end) {
|
||||||
|
|||||||
@@ -1021,7 +1021,6 @@ struct sockopt_type {
|
|||||||
/* List of supported socket options; The type JANET_POINTER is used
|
/* List of supported socket options; The type JANET_POINTER is used
|
||||||
* for options that require special handling depending on the type. */
|
* for options that require special handling depending on the type. */
|
||||||
static const struct sockopt_type sockopt_type_list[] = {
|
static const struct sockopt_type sockopt_type_list[] = {
|
||||||
{ "tcp-nodelay", IPPROTO_TCP, TCP_NODELAY, JANET_BOOLEAN },
|
|
||||||
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
|
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
|
||||||
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
|
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
|
||||||
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
|
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
|
||||||
@@ -1043,7 +1042,6 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||||||
"- :so-broadcast boolean\n"
|
"- :so-broadcast boolean\n"
|
||||||
"- :so-reuseaddr boolean\n"
|
"- :so-reuseaddr boolean\n"
|
||||||
"- :so-keepalive boolean\n"
|
"- :so-keepalive boolean\n"
|
||||||
"- :tcp-nodelay boolean\n"
|
|
||||||
"- :ip-multicast-ttl number\n"
|
"- :ip-multicast-ttl number\n"
|
||||||
"- :ip-add-membership string\n"
|
"- :ip-add-membership string\n"
|
||||||
"- :ip-drop-membership string\n"
|
"- :ip-drop-membership string\n"
|
||||||
|
|||||||
@@ -67,7 +67,6 @@
|
|||||||
#include <crt_externs.h>
|
#include <crt_externs.h>
|
||||||
#define environ (*_NSGetEnviron())
|
#define environ (*_NSGetEnviron())
|
||||||
#include <AvailabilityMacros.h>
|
#include <AvailabilityMacros.h>
|
||||||
int chroot(const char *dirname);
|
|
||||||
#else
|
#else
|
||||||
extern char **environ;
|
extern char **environ;
|
||||||
#endif
|
#endif
|
||||||
@@ -1542,27 +1541,6 @@ JANET_CORE_FN(os_posix_fork,
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_posix_chroot,
|
|
||||||
"(os/posix-chroot dirname)",
|
|
||||||
"Call `chroot` to change the root directory to `dirname`. "
|
|
||||||
"Not supported on all systems (POSIX only).") {
|
|
||||||
janet_sandbox_assert(JANET_SANDBOX_CHROOT);
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
janet_panic("not supported on Windows");
|
|
||||||
#else
|
|
||||||
const char *root = janet_getcstring(argv, 0);
|
|
||||||
int result;
|
|
||||||
do {
|
|
||||||
result = chroot(root);
|
|
||||||
} while (result == -1 && errno == EINTR);
|
|
||||||
if (result == -1) {
|
|
||||||
janet_panic(janet_strerror(errno));
|
|
||||||
}
|
|
||||||
return janet_wrap_nil();
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
/* Runs in a separate thread */
|
/* Runs in a separate thread */
|
||||||
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||||
@@ -2871,7 +2849,6 @@ void janet_lib_os(JanetTable *env) {
|
|||||||
JANET_CORE_REG("os/touch", os_touch),
|
JANET_CORE_REG("os/touch", os_touch),
|
||||||
JANET_CORE_REG("os/realpath", os_realpath),
|
JANET_CORE_REG("os/realpath", os_realpath),
|
||||||
JANET_CORE_REG("os/cd", os_cd),
|
JANET_CORE_REG("os/cd", os_cd),
|
||||||
JANET_CORE_REG("os/posix-chroot", os_posix_chroot),
|
|
||||||
#ifndef JANET_NO_UMASK
|
#ifndef JANET_NO_UMASK
|
||||||
JANET_CORE_REG("os/umask", os_umask),
|
JANET_CORE_REG("os/umask", os_umask),
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -68,7 +68,6 @@ typedef struct {
|
|||||||
int has_worker;
|
int has_worker;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
HANDLE worker;
|
HANDLE worker;
|
||||||
HANDLE worker_event;
|
|
||||||
#else
|
#else
|
||||||
pthread_t worker;
|
pthread_t worker;
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
1915
src/core/sysir.c
1915
src/core/sysir.c
File diff suppressed because it is too large
Load Diff
337
src/core/sysir.h
337
src/core/sysir.h
@@ -1,337 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2024 Calvin Rose
|
|
||||||
*
|
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
||||||
* of this software and associated documentation files (the "Software"), to
|
|
||||||
* deal in the Software without restriction, including without limitation the
|
|
||||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
|
||||||
* sell copies of the Software, and to permit persons to whom the Software is
|
|
||||||
* furnished to do so, subject to the following conditions:
|
|
||||||
*
|
|
||||||
* The above copyright notice and this permission notice shall be included in
|
|
||||||
* all copies or substantial portions of the Software.
|
|
||||||
*
|
|
||||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
||||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
||||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
||||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
||||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
||||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
|
||||||
* IN THE SOFTWARE.
|
|
||||||
*/
|
|
||||||
|
|
||||||
/****
|
|
||||||
* The System Dialect Intermediate Representation (sysir) is a compiler intermediate representation
|
|
||||||
* that for "System Janet" a dialect for "System Programming". Sysir can then be retargeted to C or direct to machine
|
|
||||||
* code for JIT or AOT compilation.
|
|
||||||
*/
|
|
||||||
|
|
||||||
/* TODO
|
|
||||||
* [x] encode constants directly in 3 address codes - makes codegen easier
|
|
||||||
* [x] typed constants
|
|
||||||
* [x] named registers and types
|
|
||||||
* [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
|
|
||||||
* [-] x86/x64 machine code target - in progress
|
|
||||||
* [ ] handle floating point types
|
|
||||||
* [ ] handle array types
|
|
||||||
* [ ] emit machine code directly
|
|
||||||
* [ ] target specific extensions - custom instructions and custom primitives
|
|
||||||
* [ ] better casting semantics
|
|
||||||
* [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)?
|
|
||||||
* [x] fixed-size array types
|
|
||||||
* [x] recursive pointer types
|
|
||||||
* [ ] global and thread local state
|
|
||||||
* [x] union types?
|
|
||||||
* [x] incremental compilation - save type definitions for later
|
|
||||||
* [ ] Extension to C target for interfacing with Janet
|
|
||||||
* [x] pointer math, pointer types
|
|
||||||
* [x] composite types - support for load, store, move, and function args.
|
|
||||||
* [x] Have some mechanism for field access (dest = src.offset)
|
|
||||||
* [x] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this.
|
|
||||||
* [x] support for stack allocation of arrays
|
|
||||||
* [ ] more math intrinsics
|
|
||||||
* [x] source mapping (using built in Janet source mapping metadata on tuples)
|
|
||||||
* [x] unit type or void type
|
|
||||||
* [ ] (typed) function pointer types and remove calling untyped pointers
|
|
||||||
* [x] APL array semantics for binary operands (maybe?)
|
|
||||||
* [ ] a few built-in array combinators (maybe?)
|
|
||||||
* [ ] multiple error messages in one pass
|
|
||||||
* [ ] better verification of constants
|
|
||||||
* [x] don't allow redefining types
|
|
||||||
* [ ] generate elf/mach-o/pe directly
|
|
||||||
* [ ] elf
|
|
||||||
* [ ] mach-o
|
|
||||||
* [ ] pe
|
|
||||||
* [ ] generate dwarf info
|
|
||||||
*/
|
|
||||||
|
|
||||||
#ifndef JANET_SYSIR_H
|
|
||||||
#define JANET_SYSIR_H
|
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
|
||||||
#include "features.h"
|
|
||||||
#include <janet.h>
|
|
||||||
#include "state.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
typedef enum {
|
|
||||||
JANET_PRIM_U8,
|
|
||||||
JANET_PRIM_S8,
|
|
||||||
JANET_PRIM_U16,
|
|
||||||
JANET_PRIM_S16,
|
|
||||||
JANET_PRIM_U32,
|
|
||||||
JANET_PRIM_S32,
|
|
||||||
JANET_PRIM_U64,
|
|
||||||
JANET_PRIM_S64,
|
|
||||||
JANET_PRIM_F32,
|
|
||||||
JANET_PRIM_F64,
|
|
||||||
JANET_PRIM_POINTER,
|
|
||||||
JANET_PRIM_BOOLEAN,
|
|
||||||
JANET_PRIM_STRUCT,
|
|
||||||
JANET_PRIM_UNION,
|
|
||||||
JANET_PRIM_ARRAY,
|
|
||||||
JANET_PRIM_VOID,
|
|
||||||
JANET_PRIM_UNKNOWN
|
|
||||||
} JanetPrim;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
const char *name;
|
|
||||||
JanetPrim prim;
|
|
||||||
} JanetPrimName;
|
|
||||||
|
|
||||||
typedef enum {
|
|
||||||
JANET_SYSOP_LINK_NAME,
|
|
||||||
JANET_SYSOP_PARAMETER_COUNT,
|
|
||||||
JANET_SYSOP_CALLING_CONVENTION,
|
|
||||||
JANET_SYSOP_MOVE,
|
|
||||||
JANET_SYSOP_CAST,
|
|
||||||
JANET_SYSOP_ADD,
|
|
||||||
JANET_SYSOP_SUBTRACT,
|
|
||||||
JANET_SYSOP_MULTIPLY,
|
|
||||||
JANET_SYSOP_DIVIDE,
|
|
||||||
JANET_SYSOP_BAND,
|
|
||||||
JANET_SYSOP_BOR,
|
|
||||||
JANET_SYSOP_BXOR,
|
|
||||||
JANET_SYSOP_BNOT,
|
|
||||||
JANET_SYSOP_SHL,
|
|
||||||
JANET_SYSOP_SHR,
|
|
||||||
JANET_SYSOP_LOAD,
|
|
||||||
JANET_SYSOP_STORE,
|
|
||||||
JANET_SYSOP_GT,
|
|
||||||
JANET_SYSOP_LT,
|
|
||||||
JANET_SYSOP_EQ,
|
|
||||||
JANET_SYSOP_NEQ,
|
|
||||||
JANET_SYSOP_GTE,
|
|
||||||
JANET_SYSOP_LTE,
|
|
||||||
JANET_SYSOP_CALL,
|
|
||||||
JANET_SYSOP_SYSCALL,
|
|
||||||
JANET_SYSOP_RETURN,
|
|
||||||
JANET_SYSOP_JUMP,
|
|
||||||
JANET_SYSOP_BRANCH,
|
|
||||||
JANET_SYSOP_BRANCH_NOT,
|
|
||||||
JANET_SYSOP_ADDRESS,
|
|
||||||
JANET_SYSOP_TYPE_PRIMITIVE,
|
|
||||||
JANET_SYSOP_TYPE_STRUCT,
|
|
||||||
JANET_SYSOP_TYPE_BIND,
|
|
||||||
JANET_SYSOP_ARG,
|
|
||||||
JANET_SYSOP_FIELD_GETP,
|
|
||||||
JANET_SYSOP_ARRAY_GETP,
|
|
||||||
JANET_SYSOP_ARRAY_PGETP,
|
|
||||||
JANET_SYSOP_TYPE_POINTER,
|
|
||||||
JANET_SYSOP_TYPE_ARRAY,
|
|
||||||
JANET_SYSOP_TYPE_UNION,
|
|
||||||
JANET_SYSOP_POINTER_ADD,
|
|
||||||
JANET_SYSOP_POINTER_SUBTRACT,
|
|
||||||
JANET_SYSOP_LABEL
|
|
||||||
} JanetSysOp;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
JanetPrim prim;
|
|
||||||
union {
|
|
||||||
struct {
|
|
||||||
uint32_t field_count;
|
|
||||||
uint32_t field_start;
|
|
||||||
} st;
|
|
||||||
struct {
|
|
||||||
uint32_t type;
|
|
||||||
} pointer;
|
|
||||||
struct {
|
|
||||||
uint32_t type;
|
|
||||||
uint64_t fixed_count;
|
|
||||||
} array;
|
|
||||||
};
|
|
||||||
} JanetSysTypeInfo;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
uint32_t type;
|
|
||||||
} JanetSysTypeField;
|
|
||||||
|
|
||||||
#define JANET_SYS_CALLFLAG_HAS_DEST 1
|
|
||||||
#define JANET_SYS_CALLFLAG_VARARGS 2
|
|
||||||
|
|
||||||
/* Allow read arguments to be constants to allow
|
|
||||||
* encoding immediates. This makes codegen easier. */
|
|
||||||
#define JANET_SYS_MAX_OPERAND 0x7FFFFFFFU
|
|
||||||
#define JANET_SYS_CONSTANT_PREFIX 0x80000000U
|
|
||||||
|
|
||||||
typedef enum {
|
|
||||||
JANET_SYS_CC_DEFAULT, /* Reasonable default - maps to a specific cc based on target */
|
|
||||||
JANET_SYS_CC_SYSCALL, /* Reasonable default for platform syscalls - maps to a specific cc based on target */
|
|
||||||
JANET_SYS_CC_X86_CDECL,
|
|
||||||
JANET_SYS_CC_X86_STDCALL,
|
|
||||||
JANET_SYS_CC_X86_FASTCALL,
|
|
||||||
JANET_SYS_CC_X64_SYSV,
|
|
||||||
JANET_SYS_CC_X64_SYSV_SYSCALL,
|
|
||||||
JANET_SYS_CC_X64_WINDOWS,
|
|
||||||
} JanetSysCallingConvention;
|
|
||||||
|
|
||||||
typedef enum {
|
|
||||||
JANET_SYS_TARGET_X64_WINDOWS, /* 64 bit, modern windows */
|
|
||||||
JANET_SYS_TARGET_X64_LINUX, /* x64 linux with recent kernel */
|
|
||||||
} JanetSysTarget;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
JanetSysOp opcode;
|
|
||||||
union {
|
|
||||||
struct {
|
|
||||||
uint32_t dest;
|
|
||||||
uint32_t lhs;
|
|
||||||
uint32_t rhs;
|
|
||||||
} three;
|
|
||||||
struct {
|
|
||||||
uint32_t dest;
|
|
||||||
uint32_t callee;
|
|
||||||
uint32_t arg_count;
|
|
||||||
uint8_t flags;
|
|
||||||
JanetSysCallingConvention calling_convention;
|
|
||||||
} call;
|
|
||||||
struct {
|
|
||||||
uint32_t dest;
|
|
||||||
uint32_t src;
|
|
||||||
} two;
|
|
||||||
struct {
|
|
||||||
uint32_t src;
|
|
||||||
} one;
|
|
||||||
struct {
|
|
||||||
uint32_t to;
|
|
||||||
} jump;
|
|
||||||
struct {
|
|
||||||
uint32_t cond;
|
|
||||||
uint32_t to;
|
|
||||||
} branch;
|
|
||||||
struct {
|
|
||||||
uint32_t dest_type;
|
|
||||||
uint32_t prim;
|
|
||||||
} type_prim;
|
|
||||||
struct {
|
|
||||||
uint32_t dest_type;
|
|
||||||
uint32_t arg_count;
|
|
||||||
} type_types;
|
|
||||||
struct {
|
|
||||||
uint32_t dest;
|
|
||||||
uint32_t type;
|
|
||||||
} type_bind;
|
|
||||||
struct {
|
|
||||||
uint32_t args[3];
|
|
||||||
} arg;
|
|
||||||
struct {
|
|
||||||
uint32_t r;
|
|
||||||
uint32_t st;
|
|
||||||
uint32_t field;
|
|
||||||
} field;
|
|
||||||
struct {
|
|
||||||
uint32_t dest_type;
|
|
||||||
uint32_t type;
|
|
||||||
// Include address space?
|
|
||||||
} pointer;
|
|
||||||
struct {
|
|
||||||
uint32_t dest_type;
|
|
||||||
uint32_t type;
|
|
||||||
uint64_t fixed_count;
|
|
||||||
} array;
|
|
||||||
struct {
|
|
||||||
uint32_t id;
|
|
||||||
} label;
|
|
||||||
struct {
|
|
||||||
uint32_t value;
|
|
||||||
uint32_t has_value;
|
|
||||||
} ret;
|
|
||||||
};
|
|
||||||
int32_t line;
|
|
||||||
int32_t column;
|
|
||||||
} JanetSysInstruction;
|
|
||||||
|
|
||||||
/* Shared data between multiple
|
|
||||||
* IR Function bodies. Used to link
|
|
||||||
* multiple functions together in a
|
|
||||||
* single executable or shared object with
|
|
||||||
* multiple entry points. Contains shared
|
|
||||||
* type declarations, as well as a table of linked
|
|
||||||
* functions. */
|
|
||||||
typedef struct {
|
|
||||||
uint32_t old_type_def_count;
|
|
||||||
uint32_t type_def_count;
|
|
||||||
uint32_t field_def_count;
|
|
||||||
JanetSysTypeInfo *type_defs;
|
|
||||||
JanetString *type_names;
|
|
||||||
JanetSysTypeField *field_defs;
|
|
||||||
JanetTable *irs;
|
|
||||||
JanetArray *ir_ordered;
|
|
||||||
JanetTable *type_name_lookup;
|
|
||||||
} JanetSysIRLinkage;
|
|
||||||
|
|
||||||
/* Keep source code information as well as
|
|
||||||
* typing information along with constants */
|
|
||||||
typedef struct {
|
|
||||||
uint32_t type;
|
|
||||||
Janet value;
|
|
||||||
// TODO - source and line
|
|
||||||
} JanetSysConstant;
|
|
||||||
|
|
||||||
/* IR representation for a single function.
|
|
||||||
* Allow for incremental compilation and linking. */
|
|
||||||
typedef struct {
|
|
||||||
JanetSysIRLinkage *linkage;
|
|
||||||
JanetString link_name;
|
|
||||||
uint32_t instruction_count;
|
|
||||||
uint32_t register_count;
|
|
||||||
uint32_t constant_count;
|
|
||||||
uint32_t return_type;
|
|
||||||
uint32_t has_return_type;
|
|
||||||
uint32_t parameter_count;
|
|
||||||
uint32_t label_count;
|
|
||||||
uint32_t *types;
|
|
||||||
JanetSysInstruction *instructions;
|
|
||||||
JanetString *register_names;
|
|
||||||
JanetSysConstant *constants;
|
|
||||||
JanetTable *register_name_lookup;
|
|
||||||
JanetTable *labels;
|
|
||||||
JanetSysCallingConvention calling_convention;
|
|
||||||
Janet error_ctx; /* Temporary for holding error messages */
|
|
||||||
} JanetSysIR;
|
|
||||||
|
|
||||||
/* Delay alignment info for the most part to the lowering phase */
|
|
||||||
typedef struct {
|
|
||||||
uint32_t size;
|
|
||||||
uint32_t alignment;
|
|
||||||
} JanetSysTypeLayout;
|
|
||||||
|
|
||||||
/* Keep track of names for each instruction */
|
|
||||||
extern const char *janet_sysop_names[];
|
|
||||||
extern const char *prim_to_prim_name[];
|
|
||||||
|
|
||||||
/* Utilities */
|
|
||||||
|
|
||||||
uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op);
|
|
||||||
|
|
||||||
/* Get list of uint32_t instruction arguments from a call or other variable length instruction.
|
|
||||||
Needs to be free with janet_sfree (or you can leak it and the garbage collector will eventually clean
|
|
||||||
* it up). */
|
|
||||||
uint32_t *janet_sys_callargs(JanetSysInstruction *instr, uint32_t *count);
|
|
||||||
|
|
||||||
/* Lowering */
|
|
||||||
void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into);
|
|
||||||
void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer);
|
|
||||||
void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetSysTarget target, JanetBuffer *buffer);
|
|
||||||
|
|
||||||
#endif
|
|
||||||
@@ -1,376 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2024 Calvin Rose
|
|
||||||
*
|
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
||||||
* of this software and associated documentation files (the "Software"), to
|
|
||||||
* deal in the Software without restriction, including without limitation the
|
|
||||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
|
||||||
* sell copies of the Software, and to permit persons to whom the Software is
|
|
||||||
* furnished to do so, subject to the following conditions:
|
|
||||||
*
|
|
||||||
* The above copyright notice and this permission notice shall be included in
|
|
||||||
* all copies or substantial portions of the Software.
|
|
||||||
*
|
|
||||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
||||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
||||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
||||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
||||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
||||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
|
||||||
* IN THE SOFTWARE.
|
|
||||||
*/
|
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
|
||||||
#include "features.h"
|
|
||||||
#include <janet.h>
|
|
||||||
#include "sysir.h"
|
|
||||||
#include "vector.h"
|
|
||||||
#include "util.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Lowering to C */
|
|
||||||
|
|
||||||
static const char *c_prim_names[] = {
|
|
||||||
"uint8_t",
|
|
||||||
"int8_t",
|
|
||||||
"uint16_t",
|
|
||||||
"int16_t",
|
|
||||||
"uint32_t",
|
|
||||||
"int32_t",
|
|
||||||
"uint64_t",
|
|
||||||
"int64_t",
|
|
||||||
"float",
|
|
||||||
"double",
|
|
||||||
"void *",
|
|
||||||
"bool",
|
|
||||||
"!!!struct",
|
|
||||||
"!!!union",
|
|
||||||
"!!!array",
|
|
||||||
"void",
|
|
||||||
"!!!unknown"
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Print a C constant */
|
|
||||||
static void print_const_c(JanetSysIR *ir, JanetBuffer *buf, Janet c, uint32_t tid) {
|
|
||||||
/* JanetSysTypeInfo *tinfo = &ir->linkage->type_defs[tid]; */
|
|
||||||
if (janet_checktype(c, JANET_TUPLE)) {
|
|
||||||
const Janet *elements = janet_unwrap_tuple(c);
|
|
||||||
janet_formatb(buf, "((_t%d){", tid);
|
|
||||||
for (int32_t i = 0; i < janet_tuple_length(elements); i++) {
|
|
||||||
if (i > 0) janet_formatb(buf, ", ");
|
|
||||||
/* TODO - limit recursion? */
|
|
||||||
uint32_t sub_type = ir->linkage->type_defs[tid].array.type;
|
|
||||||
print_const_c(ir, buf, elements[i], sub_type);
|
|
||||||
}
|
|
||||||
janet_formatb(buf, "})");
|
|
||||||
} else if (janet_checktype(c, JANET_ABSTRACT)) {
|
|
||||||
/* Allow printing int types */
|
|
||||||
janet_formatb(buf, "%V", c);
|
|
||||||
} else {
|
|
||||||
janet_formatb(buf, "%v", c);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void c_op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) {
|
|
||||||
if (reg < JANET_SYS_MAX_OPERAND) {
|
|
||||||
janet_formatb(buf, "_r%u", reg);
|
|
||||||
} else {
|
|
||||||
uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX;
|
|
||||||
uint32_t tid = ir->constants[constant_id].type;
|
|
||||||
Janet c = ir->constants[constant_id].value;
|
|
||||||
print_const_c(ir, buf, c, tid);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void c_emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf, JanetSysInstruction instruction, const char *op, int pointer_sugar) {
|
|
||||||
uint32_t operand_type = ir->types[instruction.three.dest];
|
|
||||||
tempbuf->count = 0;
|
|
||||||
uint32_t index_index = 0;
|
|
||||||
int is_pointer = 0;
|
|
||||||
JanetSysIRLinkage *linkage = ir->linkage;
|
|
||||||
|
|
||||||
/* Top-level pointer semantics */
|
|
||||||
if (pointer_sugar && janet_sys_optype(ir, instruction.three.dest) == JANET_PRIM_POINTER) {
|
|
||||||
operand_type = linkage->type_defs[operand_type].pointer.type;
|
|
||||||
is_pointer = 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Add nested for loops for any dimensionality of array */
|
|
||||||
while (linkage->type_defs[operand_type].prim == JANET_PRIM_ARRAY) {
|
|
||||||
janet_formatb(buffer, " for (size_t _j%u = 0; _j%u < %u; _j%u++) ",
|
|
||||||
index_index, index_index,
|
|
||||||
linkage->type_defs[operand_type].array.fixed_count,
|
|
||||||
index_index);
|
|
||||||
if (is_pointer) {
|
|
||||||
janet_formatb(tempbuf, "->els[_j%u]", index_index);
|
|
||||||
is_pointer = 0;
|
|
||||||
} else {
|
|
||||||
janet_formatb(tempbuf, ".els[_j%u]", index_index);
|
|
||||||
}
|
|
||||||
operand_type = linkage->type_defs[operand_type].array.type;
|
|
||||||
index_index++;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (is_pointer) {
|
|
||||||
janet_formatb(buffer, " *_r%u = *_r%u %s *_r%u;\n",
|
|
||||||
instruction.three.dest,
|
|
||||||
instruction.three.lhs,
|
|
||||||
op,
|
|
||||||
instruction.three.rhs);
|
|
||||||
janet_formatb(buffer, " *_r%u = *", instruction.three.dest);
|
|
||||||
c_op_or_const(ir, buffer, instruction.three.lhs);
|
|
||||||
janet_formatb(buffer, " %s ", op);
|
|
||||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
|
||||||
janet_formatb(buffer, ";\n");
|
|
||||||
} else {
|
|
||||||
Janet index_part = janet_wrap_buffer(tempbuf);
|
|
||||||
janet_formatb(buffer, " _r%u%V = ", instruction.three.dest, index_part);
|
|
||||||
c_op_or_const(ir, buffer, instruction.three.lhs);
|
|
||||||
janet_formatb(buffer, "%V %s ", index_part, op);
|
|
||||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
|
||||||
janet_formatb(buffer, "%V;\n", index_part);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
|
|
||||||
|
|
||||||
JanetBuffer *tempbuf = janet_buffer(0);
|
|
||||||
|
|
||||||
#define EMITBINOP(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 1)
|
|
||||||
#define EMITBINOP_NOSUGAR(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 0)
|
|
||||||
|
|
||||||
/* Prelude */
|
|
||||||
janet_formatb(buffer, "#include <stddef.h>\n#include <unistd.h>\n#include <stdlib.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stdio.h>\n#include <sys/syscall.h>\n#define _t0 void\n\n");
|
|
||||||
|
|
||||||
/* Emit type defs */
|
|
||||||
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
|
|
||||||
JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
|
|
||||||
for (uint32_t i = 0; i < ir->instruction_count; i++) {
|
|
||||||
JanetSysInstruction instruction = ir->instructions[i];
|
|
||||||
switch (instruction.opcode) {
|
|
||||||
default:
|
|
||||||
continue;
|
|
||||||
case JANET_SYSOP_TYPE_PRIMITIVE:
|
|
||||||
case JANET_SYSOP_TYPE_STRUCT:
|
|
||||||
case JANET_SYSOP_TYPE_UNION:
|
|
||||||
case JANET_SYSOP_TYPE_POINTER:
|
|
||||||
case JANET_SYSOP_TYPE_ARRAY:
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (instruction.line > 0) {
|
|
||||||
janet_formatb(buffer, "#line %d\n", instruction.line);
|
|
||||||
}
|
|
||||||
switch (instruction.opcode) {
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_TYPE_PRIMITIVE:
|
|
||||||
janet_formatb(buffer, "typedef %s _t%u;\n", c_prim_names[instruction.type_prim.prim], instruction.type_prim.dest_type);
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_TYPE_STRUCT:
|
|
||||||
case JANET_SYSOP_TYPE_UNION:
|
|
||||||
janet_formatb(buffer, (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) ? "typedef struct {\n" : "typedef union {\n");
|
|
||||||
for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) {
|
|
||||||
uint32_t offset = j / 3 + 1;
|
|
||||||
uint32_t index = j % 3;
|
|
||||||
JanetSysInstruction arg_instruction = ir->instructions[i + offset];
|
|
||||||
janet_formatb(buffer, " _t%u _f%u;\n", arg_instruction.arg.args[index], j);
|
|
||||||
}
|
|
||||||
janet_formatb(buffer, "} _t%u;\n", instruction.type_types.dest_type);
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_TYPE_POINTER:
|
|
||||||
janet_formatb(buffer, "typedef _t%u *_t%u;\n", instruction.pointer.type, instruction.pointer.dest_type);
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_TYPE_ARRAY:
|
|
||||||
janet_formatb(buffer, "typedef struct { _t%u els[%u]; } _t%u;\n", instruction.array.type, instruction.array.fixed_count, instruction.array.dest_type);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Emit function header */
|
|
||||||
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
|
|
||||||
JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
|
|
||||||
if (ir->link_name == NULL) {
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
janet_formatb(buffer, "\n\n_t%u %s(", ir->return_type, (ir->link_name != NULL) ? ir->link_name : janet_cstring("_thunk"));
|
|
||||||
for (uint32_t i = 0; i < ir->parameter_count; i++) {
|
|
||||||
if (i) janet_buffer_push_cstring(buffer, ", ");
|
|
||||||
janet_formatb(buffer, "_t%u _r%u", ir->types[i], i);
|
|
||||||
}
|
|
||||||
janet_buffer_push_cstring(buffer, ")\n{\n");
|
|
||||||
for (uint32_t i = ir->parameter_count; i < ir->register_count; i++) {
|
|
||||||
janet_formatb(buffer, " _t%u _r%u;\n", ir->types[i], i);
|
|
||||||
}
|
|
||||||
janet_buffer_push_cstring(buffer, "\n");
|
|
||||||
|
|
||||||
/* Emit body */
|
|
||||||
for (uint32_t i = 0; i < ir->instruction_count; i++) {
|
|
||||||
JanetSysInstruction instruction = ir->instructions[i];
|
|
||||||
if (instruction.line > 0) {
|
|
||||||
janet_formatb(buffer, "#line %d\n", instruction.line);
|
|
||||||
}
|
|
||||||
switch (instruction.opcode) {
|
|
||||||
case JANET_SYSOP_TYPE_PRIMITIVE:
|
|
||||||
case JANET_SYSOP_TYPE_BIND:
|
|
||||||
case JANET_SYSOP_TYPE_STRUCT:
|
|
||||||
case JANET_SYSOP_TYPE_UNION:
|
|
||||||
case JANET_SYSOP_TYPE_POINTER:
|
|
||||||
case JANET_SYSOP_TYPE_ARRAY:
|
|
||||||
case JANET_SYSOP_ARG:
|
|
||||||
case JANET_SYSOP_LINK_NAME:
|
|
||||||
case JANET_SYSOP_PARAMETER_COUNT:
|
|
||||||
case JANET_SYSOP_CALLING_CONVENTION:
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_LABEL: {
|
|
||||||
janet_formatb(buffer, "\n_label_%u:\n", instruction.label.id);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case JANET_SYSOP_ADDRESS:
|
|
||||||
janet_formatb(buffer, " _r%u = (void *) &", instruction.two.dest);
|
|
||||||
c_op_or_const(ir, buffer, instruction.two.src);
|
|
||||||
janet_formatb(buffer, ";\n");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_JUMP:
|
|
||||||
janet_formatb(buffer, " goto _label_%u;\n", instruction.jump.to);
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_BRANCH:
|
|
||||||
case JANET_SYSOP_BRANCH_NOT:
|
|
||||||
janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? " if (" : " if (!");
|
|
||||||
c_op_or_const(ir, buffer, instruction.branch.cond);
|
|
||||||
janet_formatb(buffer, ") goto _label_%u;\n", instruction.branch.to);
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_RETURN:
|
|
||||||
if (instruction.ret.has_value) {
|
|
||||||
janet_buffer_push_cstring(buffer, " return ");
|
|
||||||
c_op_or_const(ir, buffer, instruction.ret.value);
|
|
||||||
janet_buffer_push_cstring(buffer, ";\n");
|
|
||||||
} else {
|
|
||||||
janet_buffer_push_cstring(buffer, " return;\n");
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_ADD:
|
|
||||||
EMITBINOP("+");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_POINTER_ADD:
|
|
||||||
EMITBINOP_NOSUGAR("+");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_SUBTRACT:
|
|
||||||
EMITBINOP("-");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_POINTER_SUBTRACT:
|
|
||||||
EMITBINOP_NOSUGAR("-");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_MULTIPLY:
|
|
||||||
EMITBINOP("*");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_DIVIDE:
|
|
||||||
EMITBINOP("/");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_GT:
|
|
||||||
EMITBINOP(">");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_GTE:
|
|
||||||
EMITBINOP(">");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_LT:
|
|
||||||
EMITBINOP("<");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_LTE:
|
|
||||||
EMITBINOP("<=");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_EQ:
|
|
||||||
EMITBINOP("==");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_NEQ:
|
|
||||||
EMITBINOP("!=");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_BAND:
|
|
||||||
EMITBINOP("&");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_BOR:
|
|
||||||
EMITBINOP("|");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_BXOR:
|
|
||||||
EMITBINOP("^");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_SHL:
|
|
||||||
EMITBINOP("<<");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_SHR:
|
|
||||||
EMITBINOP(">>");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_SYSCALL:
|
|
||||||
case JANET_SYSOP_CALL: {
|
|
||||||
if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) {
|
|
||||||
janet_formatb(buffer, " _r%u = ", instruction.call.dest);
|
|
||||||
} else {
|
|
||||||
janet_formatb(buffer, " ");
|
|
||||||
}
|
|
||||||
if (instruction.opcode == JANET_SYSOP_SYSCALL) {
|
|
||||||
janet_formatb(buffer, "syscall(");
|
|
||||||
c_op_or_const(ir, buffer, instruction.call.callee);
|
|
||||||
} else {
|
|
||||||
c_op_or_const(ir, buffer, instruction.call.callee);
|
|
||||||
janet_formatb(buffer, "(");
|
|
||||||
}
|
|
||||||
uint32_t count;
|
|
||||||
uint32_t *args = janet_sys_callargs(ir->instructions + i, &count);
|
|
||||||
for (uint32_t j = 0; j < count; j++) {
|
|
||||||
if (j || instruction.opcode == JANET_SYSOP_SYSCALL) janet_formatb(buffer, ", ");
|
|
||||||
c_op_or_const(ir, buffer, args[j]);
|
|
||||||
}
|
|
||||||
janet_formatb(buffer, ");\n");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case JANET_SYSOP_CAST: {
|
|
||||||
uint32_t to = ir->types[instruction.two.dest];
|
|
||||||
janet_formatb(buffer, " _r%u = (_t%u) ", instruction.two.dest, to);
|
|
||||||
c_op_or_const(ir, buffer, instruction.two.src);
|
|
||||||
janet_formatb(buffer, ";\n");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case JANET_SYSOP_MOVE:
|
|
||||||
janet_formatb(buffer, " _r%u = ", instruction.two.dest);
|
|
||||||
c_op_or_const(ir, buffer, instruction.two.src);
|
|
||||||
janet_formatb(buffer, ";\n");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_BNOT:
|
|
||||||
janet_formatb(buffer, " _r%u = ~", instruction.two.dest);
|
|
||||||
c_op_or_const(ir, buffer, instruction.two.src);
|
|
||||||
janet_formatb(buffer, ";\n");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_LOAD:
|
|
||||||
janet_formatb(buffer, " _r%u = *(", instruction.two.dest);
|
|
||||||
c_op_or_const(ir, buffer, instruction.two.src);
|
|
||||||
janet_formatb(buffer, ");\n");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_STORE:
|
|
||||||
janet_formatb(buffer, " *(_r%u) = ", instruction.two.dest);
|
|
||||||
c_op_or_const(ir, buffer, instruction.two.src);
|
|
||||||
janet_formatb(buffer, ";\n");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_FIELD_GETP:
|
|
||||||
janet_formatb(buffer, " _r%u = &(_r%u._f%u);\n", instruction.field.r, instruction.field.st, instruction.field.field);
|
|
||||||
janet_formatb(buffer, " _r%u = &(", instruction.field.r);
|
|
||||||
janet_formatb(buffer, "._f%u);\n", instruction.field.field);
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_ARRAY_GETP:
|
|
||||||
janet_formatb(buffer, " _r%u = &(_r%u.els[", instruction.three.dest, instruction.three.lhs);
|
|
||||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
|
||||||
janet_buffer_push_cstring(buffer, "]);\n");
|
|
||||||
break;
|
|
||||||
case JANET_SYSOP_ARRAY_PGETP:
|
|
||||||
janet_formatb(buffer, " _r%u = &(_r%u->els[", instruction.three.dest, instruction.three.lhs);
|
|
||||||
c_op_or_const(ir, buffer, instruction.three.rhs);
|
|
||||||
janet_buffer_push_cstring(buffer, "]);\n");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
janet_buffer_push_cstring(buffer, "}\n");
|
|
||||||
#undef EMITBINOP
|
|
||||||
#undef EMITBINOP_NOSUGAR
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
1104
src/core/sysir_x86.c
1104
src/core/sysir_x86.c
File diff suppressed because it is too large
Load Diff
@@ -1899,7 +1899,6 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
|
|||||||
#define JANET_SANDBOX_FFI_USE 2048
|
#define JANET_SANDBOX_FFI_USE 2048
|
||||||
#define JANET_SANDBOX_FFI_JIT 4096
|
#define JANET_SANDBOX_FFI_JIT 4096
|
||||||
#define JANET_SANDBOX_SIGNAL 8192
|
#define JANET_SANDBOX_SIGNAL 8192
|
||||||
#define JANET_SANDBOX_CHROOT 16384
|
|
||||||
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
||||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||||
|
|||||||
@@ -27,7 +27,7 @@
|
|||||||
(if x
|
(if x
|
||||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
||||||
(do
|
(do
|
||||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (string e) x) (eflush)))
|
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||||
x)
|
x)
|
||||||
|
|
||||||
(defn skip-asserts
|
(defn skip-asserts
|
||||||
|
|||||||
@@ -990,17 +990,6 @@
|
|||||||
(assert (= () '() (macex '())) "macex ()")
|
(assert (= () '() (macex '())) "macex ()")
|
||||||
(assert (= '[] (macex '[])) "macex []")
|
(assert (= '[] (macex '[])) "macex []")
|
||||||
|
|
||||||
# Knuth man or boy test
|
|
||||||
(var a nil)
|
|
||||||
(defn man-or-boy [x] (a x |1 |-1 |-1 |1 |0))
|
|
||||||
(varfn a [k x1 x2 x3 x4 x5]
|
|
||||||
(var k k)
|
|
||||||
(defn b [] (-- k) (a k b x1 x2 x3 x4))
|
|
||||||
(if (<= k 0)
|
|
||||||
(+ (x4) (x5))
|
|
||||||
(b)))
|
|
||||||
(assert (= -2 (man-or-boy 2)))
|
|
||||||
(assert (= -67 (man-or-boy 10)))
|
|
||||||
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
|
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
|
||||||
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
|
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
|
||||||
|
|
||||||
|
|||||||
@@ -1,50 +0,0 @@
|
|||||||
# Copyright (c) 2025 Calvin Rose
|
|
||||||
#
|
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
||||||
# of this software and associated documentation files (the "Software"), to
|
|
||||||
# deal in the Software without restriction, including without limitation the
|
|
||||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
|
||||||
# sell copies of the Software, and to permit persons to whom the Software is
|
|
||||||
# furnished to do so, subject to the following conditions:
|
|
||||||
#
|
|
||||||
# The above copyright notice and this permission notice shall be included in
|
|
||||||
# all copies or substantial portions of the Software.
|
|
||||||
#
|
|
||||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
||||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
||||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
||||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
||||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
|
||||||
# IN THE SOFTWARE.
|
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
|
||||||
(start-suite)
|
|
||||||
|
|
||||||
(use ../examples/sysir/frontend)
|
|
||||||
(assert true) # smoke test
|
|
||||||
|
|
||||||
(def janet (dyn *executable*))
|
|
||||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
|
||||||
|
|
||||||
(defn do-expect-directory
|
|
||||||
"Iterate a directory, evaluating all scripts in the directory. Assert that the captured output of the script
|
|
||||||
is as expected according to a matching .expect file."
|
|
||||||
[dir]
|
|
||||||
(each path (sorted (os/dir dir))
|
|
||||||
(when (string/has-suffix? ".janet" path)
|
|
||||||
(def fullpath (string dir "/" path))
|
|
||||||
(def proc (os/spawn [;run janet fullpath] :p {:out :pipe :err :out}))
|
|
||||||
(def buff @"")
|
|
||||||
(var ret-code nil)
|
|
||||||
(ev/gather
|
|
||||||
(while (ev/read (proc :out) 4096 buff))
|
|
||||||
(set ret-code (os/proc-wait proc)))
|
|
||||||
(def expect-file (string dir "/" path ".expect"))
|
|
||||||
(def expected-out (slurp expect-file))
|
|
||||||
(assert (= (string/trim expected-out) (string/trim buff))
|
|
||||||
(string "\nfile: " fullpath "\nexpected:\n======\n" expected-out "\n======\ngot:\n======\n" buff "\n======\n")))))
|
|
||||||
|
|
||||||
(do-expect-directory "test/sysir")
|
|
||||||
|
|
||||||
(end-suite)
|
|
||||||
@@ -1,28 +0,0 @@
|
|||||||
(def types-asm
|
|
||||||
'((type-prim Double f64)
|
|
||||||
(type-array BigVec Double 100)))
|
|
||||||
|
|
||||||
(def add-asm
|
|
||||||
'((link-name "add_vector")
|
|
||||||
(parameter-count 2)
|
|
||||||
# Declarations
|
|
||||||
(bind a BigVec)
|
|
||||||
(bind b BigVec)
|
|
||||||
(bind c BigVec)
|
|
||||||
(add c a b)
|
|
||||||
(return c)))
|
|
||||||
|
|
||||||
(def sub-asm
|
|
||||||
'((link-name "sub_vector")
|
|
||||||
(parameter-count 2)
|
|
||||||
(bind a BigVec)
|
|
||||||
(bind b BigVec)
|
|
||||||
(bind c BigVec)
|
|
||||||
(subtract c a b)
|
|
||||||
(return c)))
|
|
||||||
|
|
||||||
(def ctx (sysir/context))
|
|
||||||
(sysir/asm ctx types-asm)
|
|
||||||
(sysir/asm ctx add-asm)
|
|
||||||
(sysir/asm ctx sub-asm)
|
|
||||||
(printf "%.99j" (sysir/to-ir ctx))
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
@[@[(type-prim Double f64) (type-array BigVec Double 100)] @[(parameter-count 0)] @[(link-name "add_vector") (parameter-count 2) (type-bind 0 BigVec) (type-bind 1 BigVec) (type-bind 2 BigVec) (add 2 0 1) (return 2)] @[(link-name "sub_vector") (parameter-count 2) (type-bind 0 BigVec) (type-bind 1 BigVec) (type-bind 2 BigVec) (subtract 2 0 1) (return 2)]]
|
|
||||||
@@ -1,22 +0,0 @@
|
|||||||
(def ir-asm
|
|
||||||
'((link-name "add_vectorp")
|
|
||||||
(parameter-count 2)
|
|
||||||
|
|
||||||
# Types
|
|
||||||
(type-prim Double f64)
|
|
||||||
(type-array BigVec Double 100)
|
|
||||||
(type-pointer BigVecP BigVec)
|
|
||||||
|
|
||||||
# Declarations
|
|
||||||
(bind 0 BigVecP)
|
|
||||||
(bind 1 BigVecP)
|
|
||||||
(bind 2 BigVecP)
|
|
||||||
(add 2 0 1)
|
|
||||||
(return 2)))
|
|
||||||
|
|
||||||
(def ctx (sysir/context))
|
|
||||||
(sysir/asm ctx ir-asm)
|
|
||||||
(printf "%j" (sysir/to-ir ctx))
|
|
||||||
(sysir/scalarize ctx)
|
|
||||||
(printf "%j" (sysir/to-ir ctx))
|
|
||||||
(print (sysir/to-c ctx))
|
|
||||||
@@ -1,66 +0,0 @@
|
|||||||
@[@[(type-prim Double f64) (type-array BigVec Double 100) (type-pointer BigVecP BigVec)] @[(link-name "add_vectorp") (parameter-count 2) (type-bind 0 BigVecP) (type-bind 1 BigVecP) (type-bind 2 BigVecP) (add 2 0 1) (return 2)]]
|
|
||||||
@[@[(type-prim Double f64) (type-array BigVec Double 100) (type-pointer BigVecP BigVec)] @[(link-name "add_vectorp") (parameter-count 2) (type-bind 0 BigVecP) (type-bind 1 BigVecP) (type-bind 2 BigVecP) (type-bind 3 U32Index) (type-bind 5 PointerTo) (type-bind 6 PointerTo) (type-bind 7 PointerTo) (type-bind 4 Boolean) (load 3 [U32Index 0]) (label 7) (gte 4 3 [U32Index 0]) (branch 4 21) (apgetp 5 0 3) (apgetp 6 1 3) (apgetp 7 2 3) (add 7 5 6) (add 3 3 [U32Index 1]) (jump 7) (label 21) (return 2)]]
|
|
||||||
#include <stddef.h>
|
|
||||||
#include <unistd.h>
|
|
||||||
#include <stdlib.h>
|
|
||||||
#include <stdint.h>
|
|
||||||
#include <stdbool.h>
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <sys/syscall.h>
|
|
||||||
#define _t0 void
|
|
||||||
|
|
||||||
#line 6
|
|
||||||
typedef double _t1;
|
|
||||||
#line 7
|
|
||||||
typedef struct { _t1 els[100]; } _t2;
|
|
||||||
#line 8
|
|
||||||
typedef _t2 *_t3;
|
|
||||||
|
|
||||||
|
|
||||||
_t3 add_vectorp(_t3 _r0, _t3 _r1)
|
|
||||||
{
|
|
||||||
_t3 _r2;
|
|
||||||
_t4 _r3;
|
|
||||||
_t5 _r4;
|
|
||||||
_t6 _r5;
|
|
||||||
_t6 _r6;
|
|
||||||
_t6 _r7;
|
|
||||||
|
|
||||||
#line 6
|
|
||||||
#line 7
|
|
||||||
#line 8
|
|
||||||
#line 11
|
|
||||||
#line 12
|
|
||||||
#line 13
|
|
||||||
#line 14
|
|
||||||
#line 14
|
|
||||||
#line 14
|
|
||||||
#line 14
|
|
||||||
#line 14
|
|
||||||
#line 14
|
|
||||||
_r3 = *(0);
|
|
||||||
#line 14
|
|
||||||
|
|
||||||
_label_0:
|
|
||||||
#line 14
|
|
||||||
_r4 = _r3 > 0;
|
|
||||||
#line 14
|
|
||||||
if (_r4) goto _label_1;
|
|
||||||
#line 14
|
|
||||||
_r5 = &(_r0->els[_r3]);
|
|
||||||
#line 14
|
|
||||||
_r6 = &(_r1->els[_r3]);
|
|
||||||
#line 14
|
|
||||||
_r7 = &(_r2->els[_r3]);
|
|
||||||
#line 14
|
|
||||||
_r7 = _r5 + _r6;
|
|
||||||
#line 14
|
|
||||||
_r3 = _r3 + 1;
|
|
||||||
#line 14
|
|
||||||
goto _label_0;
|
|
||||||
#line 14
|
|
||||||
|
|
||||||
_label_1:
|
|
||||||
#line 15
|
|
||||||
return _r2;
|
|
||||||
}
|
|
||||||
@@ -1,35 +0,0 @@
|
|||||||
(def ir-asm
|
|
||||||
'((link-name "test_function")
|
|
||||||
|
|
||||||
# Types
|
|
||||||
(type-prim Int s32)
|
|
||||||
(type-prim Double f64)
|
|
||||||
(type-struct MyPair 0 1)
|
|
||||||
(type-pointer PInt Int)
|
|
||||||
(type-array DoubleArray 1 1024)
|
|
||||||
|
|
||||||
# Declarations
|
|
||||||
(bind 0 Int)
|
|
||||||
(bind 1 Int)
|
|
||||||
(bind 2 Int)
|
|
||||||
(bind 3 Double)
|
|
||||||
(bind bob Double)
|
|
||||||
(bind 5 Double)
|
|
||||||
(bind 6 MyPair)
|
|
||||||
|
|
||||||
# Code
|
|
||||||
(move 0 (Int 10))
|
|
||||||
(move 0 (Int 21))
|
|
||||||
:location
|
|
||||||
(add 2 1 0)
|
|
||||||
(move 3 (Double 1.77))
|
|
||||||
(call :default 3 (PInt sin) 3)
|
|
||||||
(cast bob 2)
|
|
||||||
(call :default bob (PInt test_function))
|
|
||||||
(add 5 bob 3)
|
|
||||||
(jump :location)
|
|
||||||
(return 5)))
|
|
||||||
|
|
||||||
(def ctx (sysir/context))
|
|
||||||
(sysir/asm ctx ir-asm)
|
|
||||||
(print (sysir/to-c ctx))
|
|
||||||
@@ -1,71 +0,0 @@
|
|||||||
#include <stddef.h>
|
|
||||||
#include <unistd.h>
|
|
||||||
#include <stdlib.h>
|
|
||||||
#include <stdint.h>
|
|
||||||
#include <stdbool.h>
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <sys/syscall.h>
|
|
||||||
#define _t0 void
|
|
||||||
|
|
||||||
#line 5
|
|
||||||
typedef int32_t _t1;
|
|
||||||
#line 6
|
|
||||||
typedef double _t2;
|
|
||||||
#line 7
|
|
||||||
typedef struct {
|
|
||||||
_t0 _f0;
|
|
||||||
_t1 _f1;
|
|
||||||
} _t3;
|
|
||||||
#line 8
|
|
||||||
typedef _t1 *_t4;
|
|
||||||
#line 9
|
|
||||||
typedef struct { _t1 els[1024]; } _t5;
|
|
||||||
|
|
||||||
|
|
||||||
_t2 test_function()
|
|
||||||
{
|
|
||||||
_t1 _r0;
|
|
||||||
_t1 _r1;
|
|
||||||
_t1 _r2;
|
|
||||||
_t2 _r3;
|
|
||||||
_t2 _r4;
|
|
||||||
_t2 _r5;
|
|
||||||
_t3 _r6;
|
|
||||||
|
|
||||||
#line 5
|
|
||||||
#line 6
|
|
||||||
#line 7
|
|
||||||
#line 7
|
|
||||||
#line 8
|
|
||||||
#line 9
|
|
||||||
#line 12
|
|
||||||
#line 13
|
|
||||||
#line 14
|
|
||||||
#line 15
|
|
||||||
#line 16
|
|
||||||
#line 17
|
|
||||||
#line 18
|
|
||||||
#line 21
|
|
||||||
_r0 = 10;
|
|
||||||
#line 22
|
|
||||||
_r0 = 21;
|
|
||||||
|
|
||||||
_label_0:
|
|
||||||
#line 24
|
|
||||||
_r2 = _r1 + _r0;
|
|
||||||
#line 25
|
|
||||||
_r3 = 1.77;
|
|
||||||
#line 26
|
|
||||||
_r3 = sin(_r3);
|
|
||||||
#line 26
|
|
||||||
#line 27
|
|
||||||
_r4 = (_t2) _r2;
|
|
||||||
#line 28
|
|
||||||
_r4 = test_function();
|
|
||||||
#line 29
|
|
||||||
_r5 = _r4 + _r3;
|
|
||||||
#line 30
|
|
||||||
goto _label_0;
|
|
||||||
#line 31
|
|
||||||
return _r5;
|
|
||||||
}
|
|
||||||
@@ -1,62 +0,0 @@
|
|||||||
### typedef struct {float x; float y; float z;} Vec3;
|
|
||||||
###
|
|
||||||
### Vec3 addv(Vec3 a, Vec3 b) {
|
|
||||||
### Vec3 ret;
|
|
||||||
### ret.x = a.x + b.x;
|
|
||||||
### ret.y = a.y + b.y;
|
|
||||||
### ret.z = a.z + b.z;
|
|
||||||
### return ret;
|
|
||||||
### }
|
|
||||||
|
|
||||||
# Use fgetp for code gen
|
|
||||||
|
|
||||||
(def ir-asm
|
|
||||||
'((link-name "addv")
|
|
||||||
(parameter-count 2)
|
|
||||||
|
|
||||||
# Types
|
|
||||||
(type-prim Real f32)
|
|
||||||
(type-struct Vec3 Real Real Real)
|
|
||||||
(type-pointer PReal Real)
|
|
||||||
|
|
||||||
# Declarations
|
|
||||||
(bind position Vec3)
|
|
||||||
(bind velocity Vec3)
|
|
||||||
(bind next-position Vec3)
|
|
||||||
(bind dest Real)
|
|
||||||
(bind lhs Real)
|
|
||||||
(bind rhs Real)
|
|
||||||
(bind pdest PReal)
|
|
||||||
(bind plhs PReal)
|
|
||||||
(bind prhs PReal)
|
|
||||||
|
|
||||||
# Code
|
|
||||||
(fgetp pdest next-position 0)
|
|
||||||
(fgetp plhs position 0)
|
|
||||||
(fgetp prhs velocity 0)
|
|
||||||
(load lhs plhs)
|
|
||||||
(load rhs prhs)
|
|
||||||
(add dest lhs rhs)
|
|
||||||
(store pdest dest)
|
|
||||||
|
|
||||||
(fgetp pdest next-position 1)
|
|
||||||
(fgetp plhs position 1)
|
|
||||||
(fgetp prhs velocity 1)
|
|
||||||
(load lhs plhs)
|
|
||||||
(load rhs prhs)
|
|
||||||
(add dest lhs rhs)
|
|
||||||
(store pdest dest)
|
|
||||||
|
|
||||||
(fgetp pdest next-position 2)
|
|
||||||
(fgetp plhs position 2)
|
|
||||||
(fgetp prhs velocity 2)
|
|
||||||
(load lhs plhs)
|
|
||||||
(load rhs prhs)
|
|
||||||
(add dest lhs rhs)
|
|
||||||
(store pdest dest)
|
|
||||||
|
|
||||||
(return next-position)))
|
|
||||||
|
|
||||||
(def ctx (sysir/context))
|
|
||||||
(sysir/asm ctx ir-asm)
|
|
||||||
(print (sysir/to-c ctx))
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
nope
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
(print "hello")
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
hello
|
|
||||||
21
tools/x64.sh
21
tools/x64.sh
@@ -1,21 +0,0 @@
|
|||||||
#!/usr/bin/env bash
|
|
||||||
|
|
||||||
case "$2" in
|
|
||||||
c)
|
|
||||||
rm temp.bin temp.o temp.nasm
|
|
||||||
build/janet "$@" > temp.c
|
|
||||||
gcc -nostdlib temp.c -c temp.o
|
|
||||||
;;
|
|
||||||
x64)
|
|
||||||
rm temp.bin temp.o temp.nasm
|
|
||||||
build/janet "$@" > temp.nasm
|
|
||||||
nasm -felf64 temp.nasm -l temp.lst -o temp.o
|
|
||||||
;;
|
|
||||||
*)
|
|
||||||
echo "Unknown mode $2"
|
|
||||||
exit
|
|
||||||
;;
|
|
||||||
esac
|
|
||||||
|
|
||||||
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
|
|
||||||
./temp.bin
|
|
||||||
Reference in New Issue
Block a user