@@ 241,9 241,30 @@ let alocal =
visitf v ctx...
;
+@@ memo
+inline verify-alignment (ST)
+ let elements... = (elementsof ST)
+ va-lfold none
+ inline (k v i)
+ let MT = (unqualified v)
+ name := (keyof v)
+ sz := (wordcount MT) * WordTypeSize
+ offset := (offsetof ST name)
+ static-assert ((offset % sz) == 0:usize)
+ .. "field " (tostring name) " in struct " (tostring ST) " is misaligned: offset "
+ tostring offset
+ " is not a multiple of size "
+ tostring sz
+ none
+ elements...
+ ;
+
inline walkvalue (value f ctx...)
""""call f for elements of referenced value
- let elements... = (elementsof (storageof (typeof value)))
+ let T = (typeof value)
+ let ST = (storageof T)
+ verify-alignment ST
+ let elements... = (elementsof ST)
let value = (reftoptr value)
va-lfold 0
inline (k v i)
@@ 287,6 308,7 @@ run-stage;
struct Node plain
sources : (APointer (ARef this-type))
id : i32 = 0
+ value1 : bool
fn edges (self edges...)
let self = (imply self ARef)
@@ 1610,7 1610,7 @@ type+ Module
################################################################################
-struct Interpreter
+#struct Interpreter
module : Module
memory : Module
results : (Array Id)
@@ 0,0 1,358 @@
+
+using import enum
+using import struct
+using import Rc
+using import Array
+using import Map
+using import Set
+using import String
+using import testing
+using import itertools
+using import glm
+using import UTF-8
+
+import ..lib.tukan.use
+using import tukan.SHA1
+
+#
+ definite datatypes:
+
+ core types (64):
+ * 2 bit: atomic type
+ * 2 bit: vector size (1, 2, 3, 4)
+ * 2 bit: image dimensions (0, 1, 2, 3)
+ elemental values (16):
+ atomic values (4):
+ word size is always 4 bytes
+ word types: bool, unsigned, signed, float
+ vectors of atomics (3*4): fixed size arrays of 2 to 4 words
+ n-dim images (16*3):
+ 1d images of elementals of dynamic size
+ 2d images of elementals of dynamic size, requires x-stride
+ 3d images of elementals of dynamic size, requires x-stride and x*y-stride
+ composites:
+ arrays of composites and core types, of dynamic size (...)
+ tuples of composites and core types, of static size (...)
+
+unlet Value
+
+let Word = u32
+let Word4 = (vector Word 4)
+type TypeRef <: Word
+
+# type bits
+let ElementalTypeMask = 0xf:u32
+let AtomicTypeMask = 0x3:u32
+let Bool = (bitcast 0:u32 TypeRef)
+let Int = (bitcast 1:u32 TypeRef)
+let UInt = (bitcast 2:u32 TypeRef)
+let Float = (bitcast 3:u32 TypeRef)
+let VectorSizeOffset = 2:u32
+let VectorSizeMask = (0x3:u32 << VectorSizeOffset)
+let NoVec = (0:u32 << VectorSizeOffset)
+let Vec2 = (1:u32 << VectorSizeOffset)
+let Vec3 = (2:u32 << VectorSizeOffset)
+let Vec4 = (3:u32 << VectorSizeOffset)
+let CompositeOffset = 31:u32
+let IsComposite = (1:u32 << CompositeOffset) # ~x is address
+
+# composite type header bits
+let CompositeHeaderOffset = 16:u32
+let CompositeHeaderMask = (0xf:u32 << CompositeHeaderOffset)
+let IsImage1D = (1:u32 << CompositeHeaderOffset) # bottom bits: elemental-type; width
+let IsImage2D = (2:u32 << CompositeHeaderOffset) # bottom bits: elemental-type; width, height
+let IsImage3D = (3:u32 << CompositeHeaderOffset) # bottom bits: elemental-type; width, height, depth
+let IsArray = (8:u32 << CompositeHeaderOffset) # count, element-type
+let IsTuple = (9:u32 << CompositeHeaderOffset) # count, element-type, ...
+
+global memory : (Array Word)
+'append memory 0:u32
+
+fn... alloc (wordsize : usize)
+ let offset = (countof memory)
+ let nextoffset = (offset + wordsize)
+ assert (nextoffset < (1:usize << 31)) "out of memory"
+ 'resize memory nextoffset
+ copy (offset as Word)
+
+fn... vectorT (atomic-type : Word, size : Word)
+ assert ((atomic-type | AtomicTypeMask) == AtomicTypeMask) "type must be atomic"
+ assert ((size >= 1) & (size <= 4)) "vector size must be in range 2..4"
+ bitcast (atomic-type | ((size - 1) << VectorSizeOffset)) TypeRef
+
+global dedup2mem :
+ Map SHA1.DigestType Word
+ fn (x)
+ local k = x
+ let k = (bitcast &k @u32)
+ ((k @ 0) as u64 | ((k @ 1) as u64 << 32)) as hash
+
+fn... getaddr (data : @Word, count : Word)
+ let digest = (sha1 (bitcast data rawstring) (count * (sizeof Word)))
+ try
+ copy ('get dedup2mem digest)
+ else
+ let offset = (alloc count)
+ for i in (range count)
+ memory @ (offset + i) = data @ i
+ 'set dedup2mem digest offset
+ offset
+
+fn... imageT (elemental-type : TypeRef, width : Word, height : Word = 0, depth : Word = 0)
+ local tmp =
+ arrayof Word
+ storagecast
+ | elemental-type
+ if (height == 0) IsImage1D
+ elseif (depth == 0) IsImage2D
+ else IsImage3D
+ \ width height depth
+ bitcast (~ (getaddr &tmp (countof tmp))) TypeRef
+
+fn... arrayT (element-type : TypeRef, count : Word)
+ local tmp =
+ arrayof Word IsArray count element-type
+ bitcast (~ (getaddr &tmp (countof tmp))) TypeRef
+
+fn... indirect-tupleT (element-types : @TypeRef, count : Word)
+ let outcount = (count + 2)
+ let ptr = (alloca-array TypeRef outcount)
+ ptr @ 0 = IsTuple
+ ptr @ 1 = count
+ for i in (range count)
+ ptr @ (i + 2) = element-types @ i
+ bitcast (~ (getaddr (bitcast ptr @Word) outcount)) TypeRef
+
+inline tupleT (...)
+ local tmp =
+ arrayof TypeRef ...
+ indirect-tupleT &tmp (countof tmp)
+
+type+ TypeRef
+ inline embedded? (self)
+ (self & IsComposite) != IsComposite
+
+ fn wordcount (self)
+ returning usize
+ if ((self & IsComposite) == IsComposite)
+ let addr = (~ (storagecast self))
+ let head = (memory @ addr)
+ switch (head & CompositeHeaderMask)
+ case IsImage1D
+ * (this-function (bitcast (head & ElementalTypeMask) TypeRef))
+ copy ((memory @ (addr + 1)) as usize)
+ case IsImage2D
+ * (this-function (bitcast (head & ElementalTypeMask) TypeRef))
+ copy ((memory @ (addr + 1)) as usize)
+ copy ((memory @ (addr + 2)) as usize)
+ case IsImage3D
+ * (this-function (bitcast (head & ElementalTypeMask) TypeRef))
+ copy ((memory @ (addr + 1)) as usize)
+ copy ((memory @ (addr + 2)) as usize)
+ copy ((memory @ (addr + 3)) as usize)
+ case IsArray
+ * (this-function (bitcast (memory @ (addr + 2)) TypeRef))
+ copy ((memory @ (addr + 1)) as usize)
+ case IsTuple
+ count := memory @ (addr + 1)
+ fold (s = 0:usize) for i in (range count)
+ + s
+ this-function (bitcast (memory @ (addr + 2 + i)) TypeRef)
+ default 0:usize
+ else
+ switch (self & VectorSizeMask)
+ case NoVec 1:usize
+ default
+ + 1:usize
+ copy (((self & VectorSizeMask) >> VectorSizeOffset) as usize)
+
+ fn __repr (self)
+ returning string
+ if ((self & IsComposite) == IsComposite)
+ let addr = (~ (storagecast self))
+ let head = (memory @ addr)
+ switch (head & CompositeHeaderMask)
+ case IsImage1D
+ let str = (tostring (bitcast (head & ElementalTypeMask) TypeRef))
+ .. str
+ \ "*" (tostring ((memory @ (addr + 1)) as i32))
+ case IsImage2D
+ let str = (tostring (bitcast (head & ElementalTypeMask) TypeRef))
+ .. str
+ \ "*" (tostring ((memory @ (addr + 1)) as i32))
+ \ "*" (tostring ((memory @ (addr + 2)) as i32))
+ case IsImage3D
+ let str = (tostring (bitcast (head & ElementalTypeMask) TypeRef))
+ .. str
+ \ "*" (tostring ((memory @ (addr + 1)) as i32))
+ \ "*" (tostring ((memory @ (addr + 2)) as i32))
+ \ "*" (tostring ((memory @ (addr + 3)) as i32))
+ case IsArray
+ .. (tostring (bitcast (memory @ (addr + 2)) TypeRef))
+ \ "@" (tostring ((memory @ (addr + 1)) as i32))
+ case IsTuple
+ count := memory @ (addr + 1)
+ ..
+ fold (s = "(") for i in (range count)
+ .. s
+ if (i == 0) ""
+ else " "
+ tostring (bitcast (memory @ (addr + 2 + i)) TypeRef)
+ ")"
+ default
+ "?"
+ else
+ switch (self & VectorSizeMask)
+ case NoVec
+ switch (self & AtomicTypeMask)
+ case Bool "bool"
+ case Int "int"
+ case UInt "uint"
+ case Float "float"
+ default "?"
+ default
+ ..
+ switch (self & AtomicTypeMask)
+ case Bool "b"
+ case Int "i"
+ case UInt "u"
+ case Float ""
+ default "?"
+ "vec"
+ tostring
+ (((self & VectorSizeMask) >> VectorSizeOffset) as i32) + 1
+
+fn... stringT (count : usize)
+ arrayT UInt ((count as Word + (sizeof Word)) // (sizeof Word))
+
+struct Value plain
+ type : TypeRef
+ value : uvec4
+
+ fn __@ (self index)
+ let T = self.type
+ let value = self.value
+ if ((T & IsComposite) == IsComposite)
+ let addr = (~ (storagecast T))
+ let head = (memory @ addr)
+ switch (head & CompositeHeaderMask)
+ case IsArray
+ let count = ((memory @ (addr + 1)) as usize)
+ assert (index < count) "index out of bounds"
+ let ET = (bitcast (memory @ (addr + 2)) TypeRef)
+ let stride = ('wordcount ET)
+ let offset = (value @ 0)
+ Value ET
+ if ('embedded? ET)
+ @ (bitcast (& (memory @ offset)) @uvec4)
+ else offset
+ #case IsTuple
+ count := memory @ (addr + 1)
+ assert (index < count) "index out of bounds"
+ let ET = (bitcast (memory @ (addr + 2 + index)) TypeRef)
+
+
+ fold (s = 0:usize) for i in (range count)
+ + s
+ this-function (bitcast (memory @ (addr + 2 + i)) TypeRef)
+ default
+ assert false "composite value is not indexable"
+ unreachable;
+ else
+ switch (T & VectorSizeMask)
+ case NoVec
+ assert false "atomic value is not indexable"
+ unreachable;
+ default
+ let ET = ((T & AtomicTypeMask) as TypeRef)
+ this-type ET (value @ index)
+
+fn... alloc (T : TypeRef)
+ this-function ('wordcount T)
+case using alloc
+
+inline vec-constructor (T TT f)
+ fn... (x : T)
+ let x = (f x)
+ Value TT x
+ case (x : T, y : T)
+ let x y = (f x) (f y)
+ Value (vectorT TT 2)
+ uvec4 x y x y
+ case (x : T, y : T, z : T)
+ let x y z = (f x) (f y) (f z)
+ Value (vectorT TT 3)
+ uvec4 x y z 1
+ case (x : T, y : T, z : T, w : T)
+ let x y z w = (f x) (f y) (f z) (f w)
+ Value (vectorT TT 4)
+ uvec4 x y z w
+
+let boolconst = (vec-constructor bool Bool _)
+let intconst = (vec-constructor i32 Int _)
+let uintconst = (vec-constructor u32 UInt _)
+let floatconst = (vec-constructor f32 Float (inline (x) (bitcast x Word)))
+
+fn... stringconst (s : String)
+ count := (countof s)
+ let T = (stringT count)
+ let addr = (alloc T)
+ ptr := (& (memory @ addr)) as (mutable rawstring)
+ for i in (range count)
+ ptr @ i = s @ i
+ Value T addr
+
+print
+ @
+ floatconst 1 2 3
+ 0
+
+print
+ stringT 4
+ Float
+ vectorT Float 4
+ imageT (vectorT Float 3) 16
+ imageT Float 16 16
+ imageT Float 16 32 16
+ imageT Float 16 16
+ tupleT UInt Int Float
+ arrayT (vectorT Float 3) 4
+ tupleT UInt (tupleT Float Float) Int
+ tupleT;
+
+print
+ stringconst "hi"
+
+
+#
+ let readline =
+ input string Input.Readline
+ let setup =
+ input Input.Setup
+ let stdout =
+ output string Output.Stdout
+ let exit =
+ output inttype Output.Exit
+ let prompt =
+ output string Output.Prompt
+
+#fn build-code (expr)
+
+
+#build-code
+ sugar-quote
+ let exit? (equal "\n" readline)
+
+ bind exit
+ then exit? 0
+
+ bind prompt
+ then (merge setup (not exit?)) "> "
+
+ bind stdout
+ merge
+ then exit? "exiting...\n"
+ else exit? readline
+
+
+;
No newline at end of file