Limit stack size. Provide procedure thread-max-stack to set maximum stack size.

Author: objecthub

LispKit.xcodeproj/project.pbxproj

@@ -5307,7 +5307,7 @@
 			repositoryURL = "https://github.com/weichsel/ZIPFoundation";
 			requirement = {
 				kind = upToNextMajorVersion;
-				minimumVersion = 0.9.14;
+				minimumVersion = 0.9.15;
 			};
 		};
 /* End XCRemoteSwiftPackageReference section */

LispKit.xcodeproj/project.xcworkspace/xcshareddata/swiftpm/Package.resolved

@@ -50,8 +50,8 @@
       "kind" : "remoteSourceControl",
       "location" : "https://github.com/weichsel/ZIPFoundation",
       "state" : {
-        "revision" : "7254c74b49cec2cb81520523ba993c671f71b066",
-        "version" : "0.9.14"
+        "revision" : "f6a22e7da26314b38bf9befce34ae8e4b2543090",
+        "version" : "0.9.15"
       }
     }
   ],

Package.resolved

@@ -51,8 +51,8 @@
         "repositoryURL": "https://github.com/weichsel/ZIPFoundation.git",
         "state": {
           "branch": null,
-          "revision": "1b662e2e7a091710ad8a963263939984e2ebf527",
-          "version": "0.9.14"
+          "revision": "f6a22e7da26314b38bf9befce34ae8e4b2543090",
+          "version": "0.9.15"
         }
       }
     ]

Package.swift

@@ -41,7 +41,7 @@ import PackageDescription
 let package = Package(
   name: "LispKit",
   platforms: [
-    .macOS(.v10_13)
+    .macOS(.v10_14)
   ],
   products: [
     .library(name: "LispKit", targets: ["LispKit"]),
@@ -63,7 +63,7 @@ let package = Package(
              .upToNextMajor(from: "1.0.3")),
     .package(name: "ZIPFoundation",
              url: "https://github.com/weichsel/ZIPFoundation.git",
-             .upToNextMajor(from: "0.9.14")),
+             .upToNextMajor(from: "0.9.15")),
     .package(name: "swift-atomics",
              url: "https://github.com/apple/swift-atomics.git",
              .upToNextMajor(from: "1.0.2"))

Sources/LispKit/Compiler/EvalError.swift

@@ -98,6 +98,7 @@ public enum EvalError: Int, Hashable {
   case cyclicImportExport
   case corruptLibrary
   case redefinitionOfImport
+  case stackOverflow
   case unknownFile
   case unknownDirectory
   case unknownSystemDirectory
@@ -308,6 +309,8 @@ public enum EvalError: Int, Hashable {
         return "internal state of library $0 is corrupt ($,1)"
       case .redefinitionOfImport:
         return "redefinition of imported definition $0 in library $1"
+      case .stackOverflow:
+        return "stack overflow"
       case .unknownFile:
         return "file '$,0' unknown or a directory"
       case .unknownDirectory:

Sources/LispKit/Primitives/ThreadLibrary.swift

@@ -65,6 +65,7 @@ public final class ThreadLibrary: NativeLibrary {
     self.define(Procedure("thread-runnable?", self.isThreadRunnable))
     self.define(Procedure("thread-blocked?", self.isThreadBlocked))
     self.define(Procedure("thread-terminated?", self.isThreadTerminated))
+    self.define(Procedure("thread-max-stack", self.threadMaxStack))
     self.define(Procedure("thread-start!", self.threadStart))
     self.define(Procedure("thread-yield!", self.threadYield))
     self.define(Procedure("thread-sleep!", self.threadSleep))
@@ -218,6 +219,50 @@ public final class ThreadLibrary: NativeLibrary {
     return .makeBoolean(try self.thread(from: th).value.state == .terminated)
   }
 
+  private func threadMaxStack(fst: Expr?, snd: Expr?) throws -> Expr {
+    guard let snd = snd else {
+      guard let fst = fst else {
+        if let limit = self.context.evaluator.threads.current?.value.machine?.limitSp {
+          return .makeNumber(limit)
+        } else {
+          return .false
+        }
+      }
+      switch fst {
+        case .fixnum(let limit):
+          if let machine = self.context.evaluator.threads.current?.value.machine {
+            if limit >= 1000 && limit <= Int64(Int.max) { 
+              _ = machine.setStackLimit(to: Int(limit))
+            }
+            return .makeNumber(machine.limitSp)
+          } else {
+            return .false
+          }
+        case .object(let obj):
+          guard let nt = obj as? NativeThread else {
+            throw RuntimeError.type(fst, expected: [NativeThread.type])
+          }
+          if let machine = nt.value.machine {
+            return .makeNumber(machine.limitSp)
+          } else {
+            return .false
+          }
+        default:
+          throw RuntimeError.type(fst, expected: [.fixnumType])
+      }
+    }
+    let thread = try self.thread(from: fst!)
+    let limit = try snd.asInt()
+    if let machine = thread.value.machine {
+      if limit >= 1000 {
+        _ = machine.setStackLimit(to: limit)
+      }
+      return .makeNumber(machine.limitSp)
+    } else {
+      return .false
+    }
+  }
+  
   private func threadStart(th: Expr) throws -> Expr {
     let thread = try self.thread(from: th)
     try thread.value.start()

Sources/LispKit/Runtime/Context.swift

@@ -91,7 +91,8 @@ open class Context {
               includeDocumentPath: String?,
               assetPath: String?,
               gcDelay: Double,
-              features: [String]) {
+              features: [String],
+              limitStack: Int) {
     // Initialize components
     self.delegate = delegate
     self.implementationName = implementationName
@@ -116,7 +117,7 @@ open class Context {
     self.features = supported
     self.libraries = LibraryManager(for: self)
     self.environment = Environment(in: self)
-    self.evaluator = Evaluator(for: self)
+    self.evaluator = Evaluator(for: self, limitStack: limitStack)
     self.inputPort = Port(input: TextInput(source: delegate,
                                            abortionCallback: self.evaluator.isAbortionRequested))
     self.outputPort = Port(output: TextOutput(target: delegate, threshold: 0))

Sources/LispKit/Runtime/Evaluator.swift

@@ -63,9 +63,9 @@ public final class Evaluator: TrackedObject {
   /// All managed threads
   internal var threads = ThreadManager()
 
-  init(for context: Context) {
+  init(for context: Context, limitStack: Int = 10000000) {
     self.context = context
-    self.main = VirtualMachine(for: context)
+    self.main = VirtualMachine(for: context, limitStack: limitStack)
     context.objects.manage(self.main)
     super.init()
     self.mainThread = NativeThread(EvalThread(worker: self))

Sources/LispKit/Runtime/LispKitContext.swift

@@ -57,7 +57,8 @@ public final class LispKitContext: Context {
                        includeDocumentPath: String? = "LispKit",
                        assetPath: String? = nil,
                        gcDelay: Double = 5.0,
-                       features: [String] = []) {
+                       features: [String] = [],
+                       limitStack: Int = 10000000) {
     super.init(delegate: delegate,
                implementationName: implementationName ?? LispKitContext.implementationName,
                implementationVersion: implementationVersion ?? LispKitContext.implementationVersion,
@@ -67,6 +68,7 @@ public final class LispKitContext: Context {
                includeDocumentPath: includeDocumentPath,
                assetPath: assetPath,
                gcDelay: gcDelay,
-               features: features)
+               features: features,
+               limitStack: limitStack)
   }
 }