# HG changeset patch # User Leonard Ritter # Date 1653404179 -7200 # Tue May 24 16:56:19 2022 +0200 # Node ID 34204081dba4d267478eed4b576609d5f17dac43 # Parent a0d79e0623312ff1cac400a39d5111a5b1d3d5b4 * zarray related fixes diff --git a/lib/tukan/CADAG/init.sc b/lib/tukan/CADAG/init.sc --- a/lib/tukan/CADAG/init.sc +++ b/lib/tukan/CADAG/init.sc @@ -168,7 +168,8 @@ _ idoffsets nextindex spice gen-id-offset-func (QT) - _gen-id-offset-func (QT as type) + let f = (_gen-id-offset-func (QT as type)) + f fn _flexible-struct-type (T) let T = ('storageof T) @@ -263,7 +264,7 @@ let body = (sc_expression_new) let SZ = (('sizeof ST) as u32) vvv bind str - fold (str = `"") for i ET in (enumerate ('elements ST)) + fold (str = `(string "")) for i ET in (enumerate ('elements ST)) if ('unsized? ET) # last element let ET = ('element@ ET 0) let ETsz = (('sizeof ET) as u32) @@ -283,7 +284,7 @@ let numelements = ((sz * u32_size - SZ) // ETsz) let arr = (value @ i) let str = - loop (k str = 0:u32 str) + loop (k str = 0:u32 (string str)) if (k == numelements) break str let elem = (arr @ k) @@ -535,7 +536,9 @@ else unreachable; error - .. "typeid " (repr code) " already mapped to type " (repr info.T) + .. "CADAG: type `" name "` uses typeid " (repr code) + \ ", but it is already mapped to type " info.name + \ " : " (repr info.T) 'set self.typeid->info-map code (deref ti) @@ -617,9 +620,9 @@ fn _name (self) 'dispatch self inline "#hidden" (code cls) - x := (('typeinfo cls code) . name) as rawstring + x := (('typeinfo cls code) . name) static-assert (constant? x) - x + x as rawstring let dedup? = (Accessor (inline (self) ('_dedup? (copy self)))) let name = (Accessor (inline (self) ('_name (copy self)))) @@ -716,7 +719,7 @@ inline __typecall (cls typeid) let info = ('typeinfo typeid) let T = - type (.. "(" (tostring cls) " " info.name ")") < cls : u32 + type (.. "(" (tostring cls) " " (info.name as zarray) ")") < cls : u32 let Type = info.T let TypeId = typeid let Name = info.name diff --git a/lib/tukan/FIR.sc b/lib/tukan/FIR.sc --- a/lib/tukan/FIR.sc +++ b/lib/tukan/FIR.sc @@ -169,7 +169,7 @@ define-type "cell" (RIFF "CELL") (tuple (items = (array AnyId))) instrcolor... -define-type "text" (RIFF "TEXT") (tuple (chars = (array char))) +define-type "blob" (RIFF "BLOB") (tuple (chars = (array char))) stringcolor... define-type "symbol" (RIFF "SYMN") (tuple (string = AnyId)) stringcolor... @@ -999,7 +999,7 @@ spice-quote let pg = (Program) call - attach-shaders pg + attach-shaders (view pg) compute = main debug = true let ptr = [(getglprogram self.setup-ctx offset)] @@ -1021,7 +1021,7 @@ spice-quote let pg = (Program) call - attach-shaders pg + attach-shaders (view pg) vertex = vertex-main fragment = fragment-main debug = true @@ -1394,7 +1394,7 @@ for i in (range numbindings) let bindid = (copy (bindings @ i)) let bhandle = ('handleof module bindid) - dispatch bhandle + dispatch (view bhandle) case rbind (rbind) let v k = rbind.source rbind.target let khandle = ('handleof module k) @@ -1447,7 +1447,7 @@ BindFramebuffer FRAMEBUFFER fboptr fbo = fbo-offset ; - let fbo-offset = ('force-unwrap fbo) + let fbo-offset = ('force-unwrap (view fbo)) let fbosetupptr = (getgluint ctx.setup-ctx fbo-offset) let imageoffset = (get v) let svptr = (getgluint ctx.setup-ctx imageoffset) @@ -1507,7 +1507,7 @@ let status = (CheckNamedFramebufferStatus fbosetupptr FRAMEBUFFER) assert (status == FRAMEBUFFER_COMPLETE) - .. "Framebuffer incomplete: " (framebuffer-status status) + .. "Framebuffer incomplete: " (string (framebuffer-status status)) fn visit (module id ctx) if ('in? ctx.values id) diff --git a/lib/tukan/gl.sc b/lib/tukan/gl.sc --- a/lib/tukan/gl.sc +++ b/lib/tukan/gl.sc @@ -596,20 +596,20 @@ fn framebuffer-status (status) match status - case GL.FRAMEBUFFER_COMPLETE "COMPLETE" - case GL.FRAMEBUFFER_UNDEFINED "UNDEFINED" - case GL.FRAMEBUFFER_INCOMPLETE_ATTACHMENT "INCOMPLETE_ATTACHMENT" - case GL.FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT "INCOMPLETE_MISSING_ATTACHMENT" - case GL.FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT "INCOMPLETE_DIMENSIONS" - case GL.FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER "INCOMPLETE_DRAW_BUFFER" - case GL.FRAMEBUFFER_INCOMPLETE_FORMATS_EXT "INCOMPLETE_FORMATS" - case GL.FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_ARB "INCOMPLETE_LAYER_COUNT" - case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS "INCOMPLETE_LAYER_TARGETS" - case GL.FRAMEBUFFER_INCOMPLETE_READ_BUFFER "INCOMPLETE_READ_BUFFER" - case GL.FRAMEBUFFER_UNSUPPORTED "UNSUPPORTED" - case GL.FRAMEBUFFER_INCOMPLETE_MULTISAMPLE "INCOMPLETE_MULTISAMPLE" - case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS "INCOMPLETE_LAYER_TARGETS" - default "?" + case GL.FRAMEBUFFER_COMPLETE &"COMPLETE" + case GL.FRAMEBUFFER_UNDEFINED &"UNDEFINED" + case GL.FRAMEBUFFER_INCOMPLETE_ATTACHMENT &"INCOMPLETE_ATTACHMENT" + case GL.FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT &"INCOMPLETE_MISSING_ATTACHMENT" + case GL.FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT &"INCOMPLETE_DIMENSIONS" + case GL.FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER &"INCOMPLETE_DRAW_BUFFER" + case GL.FRAMEBUFFER_INCOMPLETE_FORMATS_EXT &"INCOMPLETE_FORMATS" + case GL.FRAMEBUFFER_INCOMPLETE_LAYER_COUNT_ARB &"INCOMPLETE_LAYER_COUNT" + case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS &"INCOMPLETE_LAYER_TARGETS" + case GL.FRAMEBUFFER_INCOMPLETE_READ_BUFFER &"INCOMPLETE_READ_BUFFER" + case GL.FRAMEBUFFER_UNSUPPORTED &"UNSUPPORTED" + case GL.FRAMEBUFFER_INCOMPLETE_MULTISAMPLE &"INCOMPLETE_MULTISAMPLE" + case GL.FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS &"INCOMPLETE_LAYER_TARGETS" + default &"?" #------------------------------------------------------------------------------- @@ -926,31 +926,31 @@ fn hook-gl-debug () fn gl-debug-source (source) match source - case GL.DEBUG_SOURCE_API "API" - case GL.DEBUG_SOURCE_WINDOW_SYSTEM "Window System" - case GL.DEBUG_SOURCE_SHADER_COMPILER "Shader Compiler" - case GL.DEBUG_SOURCE_THIRD_PARTY "Third Party" - case GL.DEBUG_SOURCE_APPLICATION "Application" - case GL.DEBUG_SOURCE_OTHER "Other" - default "?" + case GL.DEBUG_SOURCE_API &"API" + case GL.DEBUG_SOURCE_WINDOW_SYSTEM &"Window System" + case GL.DEBUG_SOURCE_SHADER_COMPILER &"Shader Compiler" + case GL.DEBUG_SOURCE_THIRD_PARTY &"Third Party" + case GL.DEBUG_SOURCE_APPLICATION &"Application" + case GL.DEBUG_SOURCE_OTHER &"Other" + default &"?" fn gl-debug-type (type_) match type_ - case GL.DEBUG_TYPE_ERROR "Error" - case GL.DEBUG_TYPE_DEPRECATED_BEHAVIOR "Deprecated" - case GL.DEBUG_TYPE_UNDEFINED_BEHAVIOR "Undefined Behavior" - case GL.DEBUG_TYPE_PORTABILITY "Portability" - case GL.DEBUG_TYPE_PERFORMANCE "Performance" - case GL.DEBUG_TYPE_OTHER "Other" - default "?" + case GL.DEBUG_TYPE_ERROR &"Error" + case GL.DEBUG_TYPE_DEPRECATED_BEHAVIOR &"Deprecated" + case GL.DEBUG_TYPE_UNDEFINED_BEHAVIOR &"Undefined Behavior" + case GL.DEBUG_TYPE_PORTABILITY &"Portability" + case GL.DEBUG_TYPE_PERFORMANCE &"Performance" + case GL.DEBUG_TYPE_OTHER &"Other" + default &"?" fn gl-debug-severity (severity) match severity - case GL.DEBUG_SEVERITY_HIGH "High" - case GL.DEBUG_SEVERITY_MEDIUM "Medium" - case GL.DEBUG_SEVERITY_LOW "Low" - case GL.DEBUG_SEVERITY_NOTIFICATION "Notification" - default "?" + case GL.DEBUG_SEVERITY_HIGH &"High" + case GL.DEBUG_SEVERITY_MEDIUM &"Medium" + case GL.DEBUG_SEVERITY_LOW &"Low" + case GL.DEBUG_SEVERITY_NOTIFICATION &"Notification" + default &"?" fn gl-debug-callback (source type_ id_ severity length message userparams) #void <- (GLenum GLenum GLuint GLenum GLsizei GLchar* void*) diff --git a/lib/tukan/vm.sc b/lib/tukan/vm.sc --- a/lib/tukan/vm.sc +++ b/lib/tukan/vm.sc @@ -223,7 +223,7 @@ do let pg = (GL.Program) call - attach-shaders pg + attach-shaders (view pg) vertex = present.vertex-main fragment = present.fragment-main pg diff --git a/testing/tukdag.sc b/testing/tukdag.sc --- a/testing/tukdag.sc +++ b/testing/tukdag.sc @@ -376,7 +376,7 @@ for i entry in (enumerate l u32) items @ i = (recur module entry) let expr = - 'alloc module TypeId.typeid_expr (countof l) + 'alloc module TypeId.typeid_cell (countof l) let args = expr.items for i in (range count) args @ i = items @ i @@ -487,7 +487,7 @@ #let prog = (gen-level1-test-geometry) #let prog = (gen-level1-test) -let prog = +#let prog = do let prog = (gen-level3-test) let prog = (cleanup prog) @@ -498,7 +498,7 @@ print "lowering..." 'lower module prog -#let prog = +let prog = do let prog = (gen-level2-test-geometry) let prog = (cleanup prog)