<commit_before>;;[2004.05.26]

;; This version is for use with the SchemeWidgetLibrary.

;(module flat_threads (run-flat-threads yield-thread
;		      these-tests test-this)

(define this-unit-description 
  "swl_flat_threads.ss: simple interface for parallel computations")

(define yield-thread thread-yield)

;; Using hefty granularity right now.
;; This defines the number of engine-ticks given each 
;; thread in each time-slice.
(define flat-threads-granularity 10)

(define (run-flat-threads thks . time)   
  (let ((timeout (if (null? time) #f (* 1000 (car time)))))
;    (disp "starting flatthreads")(flush-output-port)

    (let* ([channel (thread-make-msg-queue 'flat-threads-wait-queue)]
	   [return-thread #f]
	   [threads 
	    (map (lambda (thk) 
		   (thread-fork 
		    (lambda () 
;		      (disp "running thread")(flush-output-port)
		      (thk) 
		      (thread-send-msg channel 'Thread_Done))
		    flat-threads-granularity))
		 thks)]
	   [thread-ids (map thread-number threads)]
	   [timeout-thread 
	    (if timeout
		(thread-fork 
		 (lambda ()
;		   (disp "timer starting")(flush-output-port)
		   (thread-sleep (inexact->exact (round timeout)))
;a		   (disp "timer went off")(flush-output-port)
		   (thread-send-msg channel 'Threads_Timed_Out))		      
		 flat-threads-granularity)
		#f)])
      
 ;     (disp "SETTING UP THREADS") (flush-output-port)
      
      (let loop ((counter (length threads)))
;	(disp "loop " counter) (flush-output-port)
	(if (zero? counter)
	    (begin (if timeout-thread
		       (thread-kill timeout-thread))
		   'All_Threads_Returned)
	    (case (thread-receive-msg channel)
	      [(Thread_Done) (loop (sub1 counter))]
	      [(Threads_Timed_Out)
	       ;; Some might be already dead and this might error:
	       (for-each thread-kill thread-ids)
	       'Threads_Timed_Out]))))))
	
;;======================================================================

(define these-tests (include "generic/flat_threads.tests"))

(define test-this (default-unit-tester this-unit-description these-tests))

;) ;; End module<commit_msg>*** empty log message ***<commit_after>;;[2004.05.26]

;; This version is for use with the SchemeWidgetLibrary.

;(module flat_threads (run-flat-threads yield-thread
;		      these-tests test-this)

(define this-unit-description 
  "swl_flat_threads.ss: simple interface for parallel computations")

(define yield-thread thread-yield)

;; Using hefty granularity right now.
;; This defines the number of engine-ticks given each 
;; thread in each time-slice.
(define flat-threads-granularity 10)

(define (run-flat-threads thks . time)   
  (let ((timeout (if (null? time) #f (* 1000 (car time)))))
;    (disp "starting flatthreads")(flush-output-port)

    (let* ([channel (thread-make-msg-queue 'flat-threads-wait-queue)]
	   [return-thread #f]
	   [threads 
	    (map (lambda (thk) 
		   (thread-fork 
		    (lambda () 
;		      (disp "running thread")(flush-output-port)
		      (thk) 
		      (thread-send-msg channel 'Thread_Done))
		    flat-threads-granularity))
		 thks)]
	   [thread-ids (map thread-number threads)]
	   [timeout-thread 
	    (if timeout
		(thread-fork 
		 (lambda ()
;		   (disp "timer starting")(flush-output-port)
		   (thread-sleep (inexact->exact (round timeout)))
;a		   (disp "timer went off")(flush-output-port)
		   (thread-send-msg channel 'Threads_Timed_Out))		      
		 flat-threads-granularity)
		#f)])
      
 ;     (disp "SETTING UP THREADS") (flush-output-port)
      
      (let loop ((counter (length threads)))
;	(disp "loop " counter) (flush-output-port)
	(if (zero? counter)
	    (begin (if timeout-thread
		       (thread-kill timeout-thread))
		   'All_Threads_Returned)
	    (case (thread-receive-msg channel)
	      [(Thread_Done) (loop (sub1 counter))]
	      [(Threads_Timed_Out)
	       ;; Some might be already dead and this might error:
	       (for-each thread-kill thread-ids)
	       'Threads_Timed_Out]))))))
	
;;======================================================================

(define these-tests (include "generic/flat_threads.tests"))

(define test-this (default-unit-tester this-unit-description these-tests))
(define testswlflatthreads test-this)

;) ;; End module
{'fraction_non_alphanumeric': 0.1679298910468972, 'fraction_numerical': 0.0071056371387967785, 'mean_word_length': 3.269969666329626, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2985870', 'n_tokens_mistral': 1481, 'n_tokens_neox': 1322, 'n_words': 334}