Fix code generation for stack-allocated closures (#1703)

These changes fix an issue with stack-allocated closures constructed
within loops causing unlimited stack growth.

Author: housel

documentation/source/release-notes/2025.1.rst

@@ -56,6 +56,10 @@ Compiler
 * Fixed `issue 1395 <https://github.com/dylan-lang/opendylan/issues/1395>`_, which
   prevented some valid variable names with a leading numeric from being parsed correctly.
 
+* A bug in the LLVM back-end that could cause stack overflows in
+  long-running functions that capture closures (such as for
+  exception handlers) has been fixed.
+
 Tools
 =====
 

sources/dfmc/llvm-back-end/llvm-emit-computation.dylan

@@ -139,6 +139,23 @@ define method emit-local-tmp-definition
       end if;
     end if;
     temporary-value(tmp) := alloca;
+  else
+    let c = tmp.generator;
+    if (instance?(c, <make-closure>))
+      let o = function(c.computation-closure-method);
+      if (closure?(o) & c.closure-has-dynamic-extent?)
+        let class
+          = if (instance?(o, <&keyword-method>))
+              dylan-value(#"<keyword-closure-method>")
+            else
+              dylan-value(#"<simple-closure-method>");
+            end if;
+        let closure-size = closure-size(o.environment);
+        let closure = op--stack-allocate-closure(back-end, class, closure-size);
+        let result = ins--bitcast(back-end, closure, $llvm-object-pointer-type);
+        temporary-value(tmp) := result;
+      end if;
+    end if;
   end if;
 end method;
 
@@ -481,142 +498,148 @@ end method;
 define method emit-computation
     (back-end :: <llvm-back-end>, m :: <llvm-module>, c :: <make-closure>)
  => ();
+  let temp = c.temporary;
   let o = function(c.computation-closure-method);
   let sigtmp = c.computation-signature-value;
   let key?   = instance?(o, <&keyword-method>);
-  if (closure?(o))
-    let init? = computation-init-closure?(c);
-    let top-level? = computation-top-level-closure?(c);
-    let env = o.environment;
-    let closure-inits
-      = if (init? & ~top-level?) env.closure else #() end if;
-    if (c.closure-has-dynamic-extent?)
-      // Stack-allocated closure
-      let class
-        = if (key?)
-            dylan-value(#"<keyword-closure-method>")
-          else
-            dylan-value(#"<simple-closure-method>");
-          end if;
-
-      let template = emit-reference(back-end, m, o);
-      let closure-size = closure-size(env);
-      let closure
-        = op--stack-allocate-closure(back-end, class, template, closure-size);
-
-      for (index from 0, init in closure-inits)
-        let value = emit-reference(back-end, m, init);
-        let ptr
-          = op--getslotptr(back-end, closure, class, #"environment-element",
-                           index);
-        ins--store(back-end, value, ptr);
-      end for;
+  if (temp.used?)
+    if (closure?(o))
+      let init? = computation-init-closure?(c);
+      let top-level? = computation-top-level-closure?(c);
+      let env = o.environment;
+      let closure-inits
+        = if (init? & ~top-level?) env.closure else #() end if;
+      if (c.closure-has-dynamic-extent?)
+        // Stack-allocated closure
+        let class
+          = if (key?)
+              dylan-value(#"<keyword-closure-method>")
+            else
+              dylan-value(#"<simple-closure-method>");
+            end if;
 
-      if (sigtmp)
-        // Dynamic signature
-        let signature = emit-reference(back-end, m, sigtmp);
-        let signature-ptr
-          = op--getslotptr(back-end, closure, class, #"function-signature");
-        ins--store(back-end, signature, signature-ptr);
-      end if;
+        let template = emit-reference(back-end, m, o);
+        let closure-size = closure-size(env);
+        let class-type
+          = llvm-class-type(back-end, class, repeated-size: closure-size);
+        let closure
+          = ins--bitcast(back-end, temporary-value(temp),
+                         llvm-pointer-to(back-end, class-type));
+        op--initialize-stack-allocated-closure
+          (back-end, class, template, closure, closure-size);
+
+        for (index from 0, init in closure-inits)
+          let value = emit-reference(back-end, m, init);
+          let ptr
+            = op--getslotptr(back-end, closure, class, #"environment-element",
+                             index);
+          ins--store(back-end, value, ptr);
+        end for;
 
-      let result = ins--bitcast(back-end, closure, $llvm-object-pointer-type);
-      computation-result(back-end, c, result);
-    else
-      if (sigtmp)
-        if (top-level?)
-          // Top-level method with a dynamic signature
+        if (sigtmp)
+          // Dynamic signature
           let signature = emit-reference(back-end, m, sigtmp);
-          let name = emit-name(back-end, m, o);
-          let global = llvm-builder-global(back-end, name);
-          let class = o.^object-class;
-          llvm-constrain-type
-            (global.llvm-value-type,
-             llvm-pointer-to(back-end, llvm-class-type(back-end, class)));
           let signature-ptr
-            = op--getslotptr(back-end, global, class, #"function-signature");
+            = op--getslotptr(back-end, closure, class, #"function-signature");
           ins--store(back-end, signature, signature-ptr);
-
-          let result = ins--bitcast(back-end, global, $llvm-object-pointer-type);
-          computation-result(back-end, c, result);
+        end if;
+      else
+        if (sigtmp)
+          if (top-level?)
+            // Top-level method with a dynamic signature
+            let signature = emit-reference(back-end, m, sigtmp);
+            let name = emit-name(back-end, m, o);
+            let global = llvm-builder-global(back-end, name);
+            let class = o.^object-class;
+            llvm-constrain-type
+              (global.llvm-value-type,
+               llvm-pointer-to(back-end, llvm-class-type(back-end, class)));
+            let signature-ptr
+              = op--getslotptr(back-end, global, class, #"function-signature");
+            ins--store(back-end, signature, signature-ptr);
+
+            let result
+              = ins--bitcast(back-end, global, $llvm-object-pointer-type);
+            computation-result(back-end, c, result);
+          else
+            let result
+              = if (init?)
+                  // Initialized closure
+                  let primitive
+                    = if (key?)
+                        primitive-make-keyword-closure-with-environment-signature-descriptor
+                      else
+                        primitive-make-closure-with-environment-signature-descriptor
+                      end if;
+                  apply(call-primitive, back-end, primitive,
+                        emit-reference(back-end, m, o),
+                        emit-reference(back-end, m, sigtmp),
+                        closure-size(env),
+                        map(curry(emit-reference, back-end, m), closure-inits))
+                else
+                  // Uninitialized closure
+                  let primitive
+                    = if (key?)
+                        primitive-make-keyword-closure-signature-descriptor
+                      else
+                        primitive-make-closure-signature-descriptor
+                      end if;
+                  call-primitive(back-end, primitive,
+                                 emit-reference(back-end, m, o),
+                                 emit-reference(back-end, m, sigtmp),
+                                 closure-size(env));
+                end if;
+            computation-result(back-end, c, result);
+          end if;
         else
           let result
             = if (init?)
                 // Initialized closure
                 let primitive
                   = if (key?)
-                      primitive-make-keyword-closure-with-environment-signature-descriptor
+                      primitive-make-keyword-closure-with-environment-descriptor
                     else
-                      primitive-make-closure-with-environment-signature-descriptor
+                      primitive-make-closure-with-environment-descriptor
                     end if;
                 apply(call-primitive, back-end, primitive,
                       emit-reference(back-end, m, o),
-                      emit-reference(back-end, m, sigtmp),
                       closure-size(env),
                       map(curry(emit-reference, back-end, m), closure-inits))
               else
                 // Uninitialized closure
                 let primitive
                   = if (key?)
-                      primitive-make-keyword-closure-signature-descriptor
+                      primitive-make-keyword-closure-descriptor
                     else
-                      primitive-make-closure-signature-descriptor
+                      primitive-make-closure-descriptor
                     end if;
                 call-primitive(back-end, primitive,
                                emit-reference(back-end, m, o),
-                               emit-reference(back-end, m, sigtmp),
                                closure-size(env));
               end if;
           computation-result(back-end, c, result);
         end if;
-      else
-        let result
-          = if (init?)
-              // Initialized closure
-              let primitive
-                = if (key?)
-                    primitive-make-keyword-closure-with-environment-descriptor
-                  else
-                    primitive-make-closure-with-environment-descriptor
-                  end if;
-              apply(call-primitive, back-end, primitive,
-                    emit-reference(back-end, m, o),
-                    closure-size(env),
-                    map(curry(emit-reference, back-end, m), closure-inits))
+      end if;
+    else
+      // Not a closure
+      if (sigtmp)
+        // Dynamic method signature
+        let primitive
+          = if (key?)
+              primitive-make-keyword-method-with-signature-descriptor
             else
-              // Uninitialized closure
-              let primitive
-                = if (key?)
-                    primitive-make-keyword-closure-descriptor
-                  else
-                    primitive-make-closure-descriptor
-                  end if;
-              call-primitive(back-end, primitive,
-                             emit-reference(back-end, m, o),
-                             closure-size(env));
+              primitive-make-method-with-signature-descriptor
             end if;
+        let result
+          = call-primitive(back-end, primitive,
+                           emit-reference(back-end, m, o),
+                           emit-reference(back-end, m, sigtmp));
         computation-result(back-end, c, result);
-      end if;
+      else
+        // Ordinary compile-time method signature
+        computation-result(back-end, c, emit-reference(back-end, m, o));
+      end if
     end if;
-  else
-    // Not a closure
-    if (sigtmp)
-      // Dynamic method signature
-      let primitive
-        = if (key?)
-            primitive-make-keyword-method-with-signature-descriptor
-          else
-            primitive-make-method-with-signature-descriptor
-          end if;
-      let result
-        = call-primitive(back-end, primitive,
-                         emit-reference(back-end, m, o),
-                         emit-reference(back-end, m, sigtmp));
-      computation-result(back-end, c, result);
-    else
-      // Ordinary compile-time method signature
-      computation-result(back-end, c, emit-reference(back-end, m, o));
-    end if
   end if;
 end method;
 

sources/dfmc/llvm-back-end/llvm-primitives-lambda.dylan

@@ -978,16 +978,24 @@ end method;
 // Stack allocate a closure
 define method op--stack-allocate-closure
     (back-end :: <llvm-back-end>, class :: <&class>,
-     template :: <llvm-value>, closure-size :: <integer>)
- => (new-vector :: <llvm-value>);
-  let module = back-end.llvm-builder-module;
+     closure-size :: <integer>)
+ => (closure :: <llvm-value>);
   let word-size = back-end-word-size(back-end);
-  let header-words = dylan-value(#"$number-header-words");
 
   let class-type
     = llvm-class-type(back-end, class, repeated-size: closure-size);
-  let closure
-    = ins--alloca(back-end, class-type, 1, alignment: word-size);
+  ins--alloca(back-end, class-type, 1, alignment: word-size)
+end method;
+
+// Initialize a stack-allocated closure
+define method op--initialize-stack-allocated-closure
+    (back-end :: <llvm-back-end>, class :: <&class>,
+     template :: <llvm-value>, closure :: <llvm-value>,
+     closure-size :: <integer>)
+ => ();
+  let module = back-end.llvm-builder-module;
+  let word-size = back-end-word-size(back-end);
+  let header-words = dylan-value(#"$number-header-words");
 
   // Copy from the template
   let fixed-size = header-words + ^instance-storage-size(class);
@@ -1003,7 +1011,5 @@ define method op--stack-allocate-closure
     = op--getslotptr(back-end, closure, class, #"environment-size");
   let size-ref = emit-reference(back-end, module, closure-size);
   ins--store(back-end, size-ref, size-slot-ptr);
-
-  closure
 end method;