4ae5faa0281d — Leonard Ritter a month ago
* small change in dispatch syntax
3 files changed, 199 insertions(+), 175 deletions(-)

M lib/tukan/CADAG/init.sc
M lib/tukan/FIR.sc
M testing/tukdag.sc
M lib/tukan/CADAG/init.sc +4 -13
@@ 754,7 754,6 @@ type+ CADAG
 
     fn... temp-allocate (self, typeid : u32, wordcount : u32)
         let words = self.temp
-        # replace tail index
         let endoffset = (wordcount + 2)
         'resize words endoffset
         words @ 0 = typeid

          
@@ 770,11 769,10 @@ type+ CADAG
         let cls = (typeof self)
         let words = self.words
         # replace tail index
-        let offset = (((countof words) as u32) - 1)
+        let offset = ((countof words) as u32)
         let endoffset = (offset + size)
-        'resize words (endoffset + 1)
+        'resize words endoffset
         memcpy (& (words @ offset)) ptr (size * u32_size)
-        words @ endoffset = offset
         bitcast offset cls.AnyId
 
     fn commit-from (self ptr)

          
@@ 807,11 805,6 @@ type+ CADAG
         let typeid sz ptr = (unpack (storagecast handle))
         commit-from self ptr
 
-    fn... rootid (self)
-        let cls = (typeof self)
-        # raw u32 without type id
-        bitcast (deref ('last self.words)) cls.AnyId
-
     @@ memo
     inline alloc-func (cls typeid)
         let T = (('typeinfo typeid) . T)

          
@@ 1183,8 1176,6 @@ type+ CADAG
         let postdom = (postdominators ordered pred)
         let scope = (scopetree ordered postdom)
         this-function self ordered scope
-    case (self)
-        this-function self ('rootid self)
 
     inline... store (self, typeid : TypeId, ...)
         (store-func typeid) self ...

          
@@ 1232,8 1223,8 @@ type+ CADAG
                     T := ('typeinfo cls code) . T
                     value-typeid-tostring (@ (bitcast ptr @T)) sz
 
-    fn dump (self)
-        descend self ('rootid self)
+    fn dump (self rootid)
+        descend self rootid
             on-leave =
                 capture (module id) {}
                     print ('repr module id)

          
M lib/tukan/FIR.sc +117 -105
@@ 171,7 171,7 @@ enum PrimitiveType : u32
     Triangle
     TriangleStrip
     TriangleFan
-define-type "primitive" (RIFF "PRIM") (tuple (mode = PrimitiveType) (vertexcount = AnyId) (instances = AnyId))
+define-type "primitive" (RIFF "PRIM") (tuple (mode = PrimitiveType) (vertexcount = AnyId) (instancecount = AnyId))
     stringcolor...
 enum FragmentType : u32
     Undefined

          
@@ 231,12 231,13 @@ define-type "imagewrite"    (RIFF "IMGW"
     mutinstrcolor...
 define-type "computefn"     (RIFF "CMFN") (tuple (x = u32) (y = u32) (z = u32) (body = AnyId))
     funccolor...
-define-type "bindings"      (RIFF "BIND") (tuple (entries = (array (tuple AnyId AnyId))))
+define-type "rbind"         (RIFF "RBND") (tuple (source = AnyId) (target = AnyId))
+define-type "wbind"         (RIFF "WBND") (tuple (source = AnyId) (target = AnyId))
 define-type "imagestorage"  (RIFF "IMST") (tuple (type = AnyId) (x = u32) (y = u32) (z = u32) (levels = u32) (samples = u32))
     typecolor...
 define-type "undef"         (RIFF "UNDF") (tuple (type = AnyId))
     instrcolor...
-define-type "dispatch"      (RIFF "DISP") (tuple (func = AnyId) (x = AnyId) (y = AnyId) (z = AnyId) (sources = AnyId) (sinks = AnyId))
+define-type "dispatch"      (RIFF "DISP") (tuple (func = AnyId) (x = AnyId) (y = AnyId) (z = AnyId) (bindings = (array AnyId)))
     mutinstrcolor...
 define-type "rimage"        (RIFF "RIMG") (tuple (type = AnyId) (binding = u32))
     funccolor...

          
@@ 288,8 289,7 @@ define-type "draw"          (RIFF "DRAI"
         mode : PrimitiveType
         count : AnyId
         instancecount : AnyId
-        sources : AnyId
-        sinks : AnyId
+        bindings : (array AnyId)
     mutinstrcolor...
 define-type "sampleimagelod" (RIFF "SILD") (tuple (source = AnyId) (uv = AnyId) (lod = AnyId))
     instrcolor...

          
@@ 570,6 570,13 @@ struct FIRTyper
                 sample-index = sample-index
                 generator = id
                 stage-import = (copy ctx.rootstage.stage-import)
+        case primitive (self)
+            let vertexcount = (get self.vertexcount)
+            let instancecount = (get self.instancecount)
+            StageInfo
+                sample-index = (max vertexcount.sample-index instancecount.sample-index)
+                generator = id
+                stage-import = (copy ctx.rootstage.stage-import)
         case sampleimagelod (self)
             let si = ('combine (get self.uv) (get self.lod) module)
             let source = (get self.source)

          
@@ 605,6 612,8 @@ struct FIRTyper
             pass TypeId.typeid_mul
             pass TypeId.typeid_udiv
             pass TypeId.typeid_sdiv
+            pass TypeId.typeid_urem
+            pass TypeId.typeid_srem
             pass TypeId.typeid_and
             pass TypeId.typeid_or
             pass TypeId.typeid_xor

          
@@ 728,25 737,32 @@ struct FIRTyper
         case clearimage (self)
             get self.target
         case selectfragment (self)
-            get self.default
+            let typeid count = ('vectordesc ctx module (get self.default))
+            switch typeid
+            case TypeId.typeid_fvec (fvec count)
+            case TypeId.typeid_uvec (uvec count)
+            default
+                error "can't deduce element type"
         case dispatch (self)
-            let sinkhandle = ('handleof module self.sinks)
-            let vacount = ('vacount sinkhandle)
-            dispatch sinkhandle
-            case bindings (sinks)
-                if (vacount == 1)
-                    let entries = sinks.entries
-                    get (entries @ 0 @ 0)
-                else
-                    let mrv =
-                        'alloc module TypeId.typeid_mrv vacount
-                    let entries = sinks.entries
-                    let args = mrv.types
-                    for i in (range vacount)
-                        args @ i = (get (entries @ i @ 0))
-                    'commit module
-            default
-                trap;
+            let vacount = ('vacount handle)
+            let bindings = self.bindings
+            local wbinds : (Array (tuple AnyId AnyId))
+            for i in (range vacount)
+                let bhandle = ('handleof module (bindings @ i))
+                dispatch bhandle
+                case wbind (self)
+                    'append wbinds (tupleof self.source self.target)
+                default;
+            let wcount = ((countof wbinds) as u32)
+            if (wcount == 1)
+                get (wbinds @ 0 @ 0)
+            else
+                let mrv =
+                    'alloc module TypeId.typeid_mrv wcount
+                let args = mrv.types
+                for i entry in (enumerate wbinds u32)
+                    args @ i = (get (entry @ 0))
+                'commit module
         default
             switch ('typeidof module id)
             pass TypeId.typeid_range

          
@@ 780,7 796,8 @@ struct FIRTyper
             pass TypeId.typeid_output
             pass TypeId.typeid_imagewrite
             pass TypeId.typeid_computefn
-            pass TypeId.typeid_bindings
+            pass TypeId.typeid_rbind
+            pass TypeId.typeid_wbind
             pass TypeId.typeid_overlay
             do NoId
 

          
@@ 803,6 820,7 @@ struct FIRTyper
             # first value is type
             pass TypeId.typeid_undef
             pass TypeId.typeid_wimage
+            pass TypeId.typeid_rattr
             pass TypeId.typeid_uniform
             do
                 for srcid in ('sources handle)

          
@@ 904,7 922,7 @@ fn... getglprogram (ctx : Value, offset 
 static-assert ((sizeof GL.uint) == (sizeof u32))
 static-assert ((sizeof GL.Program) == (sizeof u32))
 
-fn generate-IL (module)
+fn generate-IL (module rootid)
     using import glm
     using import glsl
     using import tukan.gl

          
@@ 1308,7 1326,7 @@ fn generate-IL (module)
                 unreachable;
         imgoffset
 
-    fn assign-bindings (ctx module body retargs sources sinks)
+    fn assign-bindings (ctx module body retargs bindings numbindings)
         inline get (id...)
             va-map
                 inline (id)

          
@@ 1318,18 1336,18 @@ fn generate-IL (module)
                         #trap;
                 id...
 
+        local next_texture_unit = 0
+        local fbo : (Option Value)
+        local drawbuffers : (Array i32)
+        local next_attachment_index = 0
+
         # bind values from function body instructions
-        do
-            let handle = ('handleof module sources)
-            let numsources = ('vacount handle)
-            let sources =
-                dispatch handle
-                case bindings (self) self.entries
-                default
-                    error "sources must be bindings"
-            local next_texture_unit = 0
-            for i in (range numsources)
-                let v k = (unpack (sources @ i))
+        for i in (range numbindings)
+            let bindid = (copy (bindings @ i))
+            let bhandle = ('handleof module bindid)
+            dispatch bhandle
+            case rbind (rbind)
+                let v k = rbind.source rbind.target
                 let khandle = ('handleof module k)
                 dispatch khandle
                 case uniform (self)

          
@@ 1361,22 1379,9 @@ fn generate-IL (module)
                             BindBufferBase SHADER_STORAGE_BUFFER b v
                 default
                     error
-                        .. "invalid binding type: " (string khandle.typeid.name)
-        do
-            let handle = ('handleof module sinks)
-            let numsinks = ('vacount handle)
-            let sinks =
-                dispatch handle
-                case bindings (self) self.entries
-                default
-                    error "sources must be bindings"
-
-            local fbo : (Option Value)
-            local drawbuffers : (Array i32)
-            local next_attachment_index = 0
-
-            for i in (range numsinks)
-                let v k = (unpack (sinks @ i))
+                        .. "invalid read binding type: " (string khandle.typeid.name)
+            case wbind (wbind)
+                let v k = wbind.source wbind.target
                 let khandle = ('handleof module k)
                 dispatch khandle
                 case wattr (self)

          
@@ 1427,30 1432,33 @@ fn generate-IL (module)
                                 imgfmt
                 default
                     error
-                        .. "invalid binding type: " (string khandle.typeid.name)
+                        .. "invalid write binding type: " (string khandle.typeid.name)
+            default
+                error
+                    .. "read or write binding expected, not " ('repr module bindid)
 
-            if fbo
-                let fbo-offset = ('force-unwrap fbo)
-                let fbosetupptr = (getgluint ctx.setup-ctx fbo-offset)
-                from GL let NamedFramebufferDrawBuffers CheckNamedFramebufferStatus
-                    \ FRAMEBUFFER FRAMEBUFFER_COMPLETE
-                let GLenum = GL.enum
-                let drawbuffercount = (countof drawbuffers)
-                sc_expression_append ctx.setup-body
-                    let buffertargets = (alloca-array GLenum drawbuffercount)
-                for i target in (enumerate drawbuffers)
-                    sc_expression_append ctx.setup-body `(buffertargets @ i = target)
-                sc_expression_append ctx.setup-body
-                    spice-quote
-                        NamedFramebufferDrawBuffers
-                            \ fbosetupptr drawbuffercount buffertargets
+        if fbo
+            let fbo-offset = ('force-unwrap fbo)
+            let fbosetupptr = (getgluint ctx.setup-ctx fbo-offset)
+            from GL let NamedFramebufferDrawBuffers CheckNamedFramebufferStatus
+                \ FRAMEBUFFER FRAMEBUFFER_COMPLETE
+            let GLenum = GL.enum
+            let drawbuffercount = (countof drawbuffers)
+            sc_expression_append ctx.setup-body
+                let buffertargets = (alloca-array GLenum drawbuffercount)
+            for i target in (enumerate drawbuffers)
+                sc_expression_append ctx.setup-body `(buffertargets @ i = target)
+            sc_expression_append ctx.setup-body
+                spice-quote
+                    NamedFramebufferDrawBuffers
+                        \ fbosetupptr drawbuffercount buffertargets
 
-                sc_expression_append ctx.setup-body
-                    spice-quote
-                        let status = (CheckNamedFramebufferStatus
-                            fbosetupptr FRAMEBUFFER)
-                        assert (status == FRAMEBUFFER_COMPLETE)
-                            .. "Framebuffer incomplete: " (framebuffer-status status)
+            sc_expression_append ctx.setup-body
+                spice-quote
+                    let status = (CheckNamedFramebufferStatus
+                        fbosetupptr FRAMEBUFFER)
+                    assert (status == FRAMEBUFFER_COMPLETE)
+                        .. "Framebuffer incomplete: " (framebuffer-status status)
 
     fn visit (module id ctx)
         if ('in? ctx.values id)

          
@@ 1619,7 1627,8 @@ fn generate-IL (module)
             #let format = (imageformat->symbol self.format)
             `[(sc_sampled_image_type
                 (sc_image_type T dim 0 arrayed? multisampled? 1 'Unknown unnamed))]
-        case bindings (self) `none
+        case rbind (self) `none
+        case wbind (self) `none
         case imagestorage (self) `none
         case undef (self)
             dispatch ('handleof module self.type)

          
@@ 1730,7 1739,7 @@ fn generate-IL (module)
             let pg = (getgluint ctx.drive-ctx pgoffset)
             let x y = (get self.x self.y)
             let count instancecount = (get self.count self.instancecount)
-            let sources sinks = self.sources self.sinks
+            let bindings = self.bindings
 
             from GL let UseProgram BindFramebuffer Viewport DrawArraysInstanced
                 \ BindVertexArray

          
@@ 1759,7 1768,7 @@ fn generate-IL (module)
 
             local retargs : (Array Value)
 
-            assign-bindings ctx module body retargs sources sinks
+            assign-bindings ctx module body retargs bindings vacount
 
             sc_expression_append body `(Viewport 0 0 (x as i32) (y as i32))
 

          
@@ 1774,7 1783,7 @@ fn generate-IL (module)
             let pgoffset = (get self.func)
             let pg = (getgluint ctx.drive-ctx pgoffset)
             let x y z = (get self.x self.y self.z)
-            let sources sinks = self.sources self.sinks
+            let bindings = self.bindings
 
             from GL let DispatchCompute DispatchComputeIndirect
                 \ BindBuffer DISPATCH_INDIRECT_BUFFER UseProgram

          
@@ 1790,7 1799,7 @@ fn generate-IL (module)
 
             local retargs : (Array Value)
 
-            assign-bindings ctx module body retargs sources sinks
+            assign-bindings ctx module body retargs bindings vacount
 
             sc_expression_append body dispatchcmd
             sc_expression_append body `(UseProgram 0)

          
@@ 1852,7 1861,6 @@ fn generate-IL (module)
             drop-ctx = drop-ctx
             drop-body = drop-body
 
-    let rootid = ('rootid module)
     FIRTyper.setup module
 
     'descend module rootid

          
@@ 2029,10 2037,10 @@ fn fold-constant-expression (typer self 
     default;
     cls.NoId
 
-fn fold-constant-expressions (self)
+fn fold-constant-expressions (self rootid)
     let cls = (typeof self)
     local typer : FIRTyper
-    'translate self self ('rootid self)
+    'translate self self rootid
         on-leave =
             capture (module handle oldmodule id) {&typer}
                 try

          
@@ 2185,7 2193,7 @@ fn lower-FIR (module rootid)
         let imgtype = (image ImageDim.2D imgformat ImageFlags.none)
         _ (imagestorage imgtype cx cy cz 1 0) imgtype imgformat met
 
-    fn gendispatch (ctx module source)
+    fn lower-expression (ctx module source)
         dispatch ('handleof module ('typeof ctx.typer module source))
         case imagestorage (imgstor)
             dispatch ('handleof module imgstor.type)

          
@@ 2229,30 2237,34 @@ fn lower-FIR (module rootid)
         let source =
             'translate module module source
                 aliases = (view importmap)
-        let sources =
-            'alloc module TypeId.typeid_bindings numsources
-        local ofs = 0
-        let entries = sources.entries
-        for k v in (zip imports uniforms)
-            entries @ ofs =
-                tupleof k v
-            ofs += 1
-        let sources = ('commit module)
-        let writevalue = (remapvector ctx module (copy source) 4:u32)
         from (methodsof module.builder) let dispatch computefn
             \ bindings wimage imagewrite load undef uvec2 comp
-            \ unpack-comp
+            \ unpack-comp rbind wbind
         let img = (wimage imgtype 0)
         let pos = (globalid)
         let uv = (uvec2 (unpack-comp pos 2))
-        let source =
-            dispatch
-                computefn lx ly lz
-                    imagewrite writevalue uv (load img)
-                \ sx sy sz
-                sources
-                bindings
-                    tupleof (undef storagetype) img
+        let writevalue = (remapvector ctx module (copy source) 4:u32)
+        let func =
+            computefn lx ly lz
+                imagewrite writevalue uv (load img)
+        local bindings : (Array AnyId)
+        'reserve bindings ((countof uniforms) + 1)
+        for src trg in (zip imports uniforms)
+            'append bindings
+                rbind src trg
+        'append bindings
+            wbind (undef storagetype) img
+        let bcount = ((countof bindings) as u32)
+        let dispatchptr =
+            'alloc module TypeId.typeid_dispatch bcount
+        dispatchptr.func = func
+        dispatchptr.x = sx
+        dispatchptr.y = sy
+        dispatchptr.z = sz
+        let entries = dispatchptr.bindings
+        for i id in (enumerate bindings u32)
+            entries @ i = id
+        let source = ('commit module)
         _ source imgformat
 
     fn translate-value (ctx module handle oldmodule id)

          
@@ 2279,7 2291,7 @@ fn lower-FIR (module rootid)
                 undef storagetype
         case sample (self)
             let source imgformat =
-                gendispatch ctx module self.source
+                lower-expression ctx module self.source
             from (methodsof module.builder) let fconst sampleimagelod
             let newid = (sampleimagelod source self.uv (fconst 0.0))
             let numcomp = ('components imgformat)

          
@@ 2290,7 2302,7 @@ fn lower-FIR (module rootid)
             case SystemKey.Screen
                 # execute dispatch
                 self.value =
-                    (_ (gendispatch ctx module self.value) ())
+                    (_ (lower-expression ctx module self.value) ())
                 'commit module handle
             default
                 error "unhandled output type"

          
M testing/tukdag.sc +78 -57
@@ 16,14 16,14 @@ using import tukan.vm
 # instantiate a module
 local module : FIR
 
-inline gen-level1-test ()
+inline gen-level1-test-geometry ()
     let _uvec3 = uvec3
     from (methodsof module.builder) let input uniform uvec wimage dispatch
         \ bindings computefn imagestorage imagewrite globalid load fdiv
         \ fconst comp utof fadd fmul sin fvec2 fvec4 udiv add uconst image
         \ outputs output uvec2 fvec draw shaderfn position vertexid
         \ rattr wattr block fsub urem store clearimage cos instanceid undef
-        \ primitiveid unpack-comp
+        \ primitiveid unpack-comp rbind wbind
 
     let inpss = (input SystemKey.ScreenSize)
     let inpit = (input SystemKey.Iteration)

          
@@ 35,25 35,6 @@ inline gen-level1-test ()
     let img = (wimage imgtype 0)
     let z = (fadd (fmul (sin (fdiv (utof inpit) (fconst 60.0))) (fconst 0.5)) (fconst 0.5))
     let angle = (fdiv (utof inpit) (fconst 60.0))
-    let func =
-        computefn 8 8 1
-            do
-                # screen size
-                let it = (load u_it)
-                let w h =
-                    load ssx
-                    load ssy
-                let pos = (globalid)
-                let x y =
-                    comp 0 pos
-                    comp 1 pos
-                let u = (fdiv (utof x) w)
-                let v = (fdiv (utof y) h)
-                let z = (load u_it)
-                imagewrite
-                    fvec4 u v z (fconst 1)
-                    uvec2 x y
-                    load img
 
     let colorattr_out = (wattr (fvec 4) 0)
     let colorattr_in = (rattr (fvec 4) 0 FragmentType.Smooth)

          
@@ 99,33 80,70 @@ inline gen-level1-test ()
                 PrimitiveType.TriangleStrip
                 uconst 4
                 uconst 10
-                bindings
-                    tupleof angle u_it
-                bindings
-                    tupleof
-                        clearimage
-                            fvec4 (uconst 0) (uconst 0) (uconst 1) (uconst 1)
-                            uconst 0
-                            uconst 0; uconst 0; uconst 0
-                            comp 0 inpss; comp 1 inpss; uconst 1
-                            undef
-                                imagestorage imgtype 4096 4096 1 1 0
-                        colorattr_frag
-    #outputs
+                rbind angle u_it
+                wbind
+                    clearimage
+                        fvec4 (uconst 0) (uconst 0) (uconst 1) (uconst 1)
+                        uconst 0
+                        uconst 0; uconst 0; uconst 0
+                        comp 0 inpss; comp 1 inpss; uconst 1
+                        undef
+                            imagestorage imgtype 4096 4096 1 1 0
+                    colorattr_frag
+
+inline gen-level1-test ()
+    let _uvec3 = uvec3
+    from (methodsof module.builder) let input uniform uvec wimage dispatch
+        \ bindings computefn imagestorage imagewrite globalid load fdiv
+        \ fconst comp utof fadd fmul sin fvec2 fvec4 udiv add uconst image
+        \ outputs output uvec2 fvec draw shaderfn position vertexid
+        \ rattr wattr block fsub urem store clearimage cos instanceid undef
+        \ primitiveid unpack-comp rbind wbind
+
+    let inpss = (input SystemKey.ScreenSize)
+    let inpit = (input SystemKey.Iteration)
+
+    let ssx = (uniform (fvec 1) 0)
+    let ssy = (uniform (fvec 1) 1)
+    let u_it = (uniform (fvec 1) 2)
+    let imgtype = (image ImageDim.2D ImageFormat.RGBA8UNORM ImageFlags.none)
+    let img = (wimage imgtype 0)
+    let z = (fadd (fmul (sin (fdiv (utof inpit) (fconst 60.0))) (fconst 0.5)) (fconst 0.5))
+    let angle = (fdiv (utof inpit) (fconst 60.0))
+    let func =
+        computefn 8 8 1
+            do
+                # screen size
+                let it = (load u_it)
+                let w h =
+                    load ssx
+                    load ssy
+                let pos = (globalid)
+                let x y =
+                    comp 0 pos
+                    comp 1 pos
+                let u = (fdiv (utof x) w)
+                let v = (fdiv (utof y) h)
+                let z = (load u_it)
+                imagewrite
+                    fvec4 u v z (fconst 1)
+                    uvec2 x y
+                    load img
+
+    outputs
         output SystemKey.Screen
             # indirect dispatch
             dispatch func
                 udiv (add (comp 0 inpss) (uconst 7)) (uconst 8)
                 udiv (add (comp 1 inpss) (uconst 7)) (uconst 8)
                 uconst 1
-                bindings
-                    tupleof (utof (comp 0 inpss)) ssx
-                    tupleof (utof (comp 1 inpss)) ssy
-                    tupleof z u_it
-                bindings
-                    tupleof
+                rbind (utof (comp 0 inpss)) ssx
+                rbind (utof (comp 1 inpss)) ssy
+                rbind z u_it
+                wbind
+                    undef
                         imagestorage imgtype 4096 4096 1 1 0
-                        img
+                    img
 
 inline gen-level2-test ()
     from (methodsof module.builder) let uvec fvec2 fvec3 fvec4 input output uconst

          
@@ 159,7 177,7 @@ inline gen-level2-test ()
             clear screenrange
                 fvec3 (fconst 0) (fconst 0) (fconst 1)
 
-    do
+    #do
         let prim = (primitive PrimitiveType.TriangleStrip (uconst 4) (uconst 1))
         let vertexid = (comp 0 prim)
         let u = (utof (urem vertexid (uconst 2)))

          
@@ 181,7 199,7 @@ inline gen-level2-test ()
                     clear screenrange
                         fvec3 (uconst 0) (uconst 0) (uconst 1)
 
-    #outputs
+    outputs
         output SystemKey.Screen
             do
                 # frame time

          
@@ 202,14 220,15 @@ inline gen-level2-test ()
 
 # perform an identity transform and swap out the new module
     all transformations are immutable.
-inline cleanup ()
+inline cleanup (rootid)
     do
         local newmodule : FIR
-        let newid = ('translate newmodule module ('rootid module))
+        let newid = ('translate newmodule module rootid)
         module = newmodule
-inline run ()
+        rootid
+inline run (rootid)
     do
-        let fsetup fdrive fdrop = ('gen-templates module)
+        let fsetup fdrive fdrop = ('gen-templates module rootid)
 
         local opts : VMOptions
         runvm fsetup fdrive fdrop opts

          
@@ 218,20 237,22 @@ inline graphviz ()
         'showdot module ('rootid module)
             module-dir .. "/tukdag"
 
-#gen-level1-test;
-do
-    gen-level2-test;
-    cleanup;
-    'dump module
-    print "lowering..."
-    'lower module ('rootid module)
+#let prog = (gen-level1-test-geometry)
+#let prog = (gen-level1-test)
+let prog =
+    do
+        let prog = (gen-level2-test)
+        cleanup prog
+        'dump module prog
+        print "lowering..."
+        'lower module prog
 print "folding constants..."
-'fold-constant-expressions module
+let prog = ('fold-constant-expressions module prog)
 #cleanup;
-'dump-scope module
+'dump-scope module prog
 #graphviz;
 print "compiling..."
-run;
+run prog
 
 drop module
 unlet module