68d90eeef6e1 — Leonard Ritter tip a day ago
* initial work on bootstrap interpreter
3 files changed, 382 insertions(+), 2 deletions(-)

M testing/arena_gc.sc
M testing/test_node2.sc
A => testing/test_node5.sc
M testing/arena_gc.sc +23 -1
@@ 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)

          
M testing/test_node2.sc +1 -1
@@ 1610,7 1610,7 @@ type+ Module
 
 ################################################################################
 
-struct Interpreter
+#struct Interpreter
     module : Module
     memory : Module
     results : (Array Id)

          
A => testing/test_node5.sc +358 -0
@@ 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