~ chicken-core (chicken-5) 7aacba829e680a9c20fdac4800d3445f624bf6c5

commit 7aacba829e680a9c20fdac4800d3445f624bf6c5
Author:     Felix <bunny351@gmail.com>
AuthorDate: Mon Oct 19 00:42:55 2009 +0200
Commit:     Felix <bunny351@gmail.com>
CommitDate: Mon Oct 19 00:42:55 2009 +0200

    removed breakpoint support from scheduler

diff --git a/scheduler.scm b/scheduler.scm
index 69f1a603..af2ce503 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -479,55 +479,3 @@ EOF
 	       (loop (##sys#slot fdl 1)) ) ) ) ) )
     (##sys#setislot t 12 '())
     (##sys#thread-basic-unblock! t) ) )
-
-
-;;; Multithreaded breakpoints
-
-(define (##sys#break-entry name args)
-  (when (or (not ##sys#break-in-thread) (eq? ##sys#break-in-thread ##sys#current-thread))
-    (##sys#call-with-current-continuation
-     (lambda (k)
-       (let* ((pk (if (eq? ##sys#current-thread ##sys#primordial-thread)
-		      '()
-		      (list '(exn . thread) ##sys#current-thread
-			    '(exn . primordial-continuation) 
-			    (lambda _ ((##sys#slot ##sys#primordial-thread 1))))))
-	      (exn (##sys#make-structure
-		    'condition
-		    '(exn breakpoint)
-		    (append 
-		     (list '(exn . message) "*** breakpoint ***"
-			   '(exn . arguments) (cons name args)
-			   '(exn . location) name
-			   '(exn . continuation) k)
-		     pk) ) ) )
-	 (set! ##sys#last-breakpoint exn)
-	 (cond ((eq? ##sys#current-thread ##sys#primordial-thread)
-		(##sys#signal exn) )
-	       (else
-		(##sys#setslot ##sys#current-thread 3 'suspended)
-		(##sys#setslot ##sys#current-thread 1 (lambda () (k (##core#undefined))))
-		(let ([old (##sys#slot ##sys#primordial-thread 1)])
-		  (##sys#setslot
-		   ##sys#primordial-thread 1
-		   (lambda ()
-		     (##sys#signal exn)
-		     (old) ) )
-		  (##sys#thread-unblock! ##sys#primordial-thread)
-		  (##sys#schedule) ) ) ) ) ) ) ) )
-		  
-(define (##sys#break-resume exn)
-  ;; assumes current-thread is primordial
-  (let* ((props (##sys#slot exn 2))
-	 (a (member '(exn . continuation) props))
-	 (t (member '(exn . thread) props))
-	 (pk (or (member '(exn . primordial-continuation) props) a)))
-    (when t
-      (let ((t (cadr t)))
-	(if a
-	    (##sys#setslot t 1 (lambda () ((cadr a) (##core#undefined))))
-	    (##sys#signal-hook #:type-error "condition has no continuation" exn) )
-	(##sys#add-to-ready-queue t) ) )
-    (if pk
-	((cadr pk) (##core#undefined))
-	(##sys#signal-hook #:type-error "condition has no continuation" exn) ) ) )