<commit_before>;;;; Cyclone Scheme
;;;; https://github.com/justinethier/cyclone
;;;;
;;;; Copyright (c) 2014-2016, <NAME>
;;;; All rights reserved.
;;;;
;;;; This module implements the multithreading API from SRFI 18.
;;;;
(define-library (srfi 18)
  (import (scheme base))
  (export
    ;; TODO: current-thread
    thread?
    make-thread
    thread-name
    thread-specific
    thread-specific-set!
    thread-start!
    thread-sleep!
    thread-yield!
    ;; TODO: thread-terminate!
    ;; TODO: thread-join!

    ;; For now, these are built-ins. No need to export them here: 
    ;; mutex?
    ;; make-mutex 
    ;; mutex-lock! 
    ;; mutex-unlock!

    ;; For now, these are not implemented:
    ;; mutex-name
    ;; mutex-specific
    ;; mutex-specific-set!
    ;; mutex-state

    ;; TODO: condition variables are not implemented yet
    condition-variable?
    make-condition-variable
    ;; (condition-variable-name condition-variable)          ;procedure
    ;; (condition-variable-specific condition-variable)      ;procedure
    ;; (condition-variable-specific-set! condition-variable obj) ;procedure
    ;; (condition-variable-signal! condition-variable)       ;procedure
    ;; (condition-variable-broadcast! condition-variable)    ;procedure

    ;; Time functions are not implemented here, see (scheme time) instead
   
    ;; Exceptions are not implemented here, r7rs exceptions are used instead

    ;; Non-standard functions:
    ->heap
    Cyc-minor-gc
  )
  (begin
    ;; Threading
    (define (thread? obj) 
      (and (vector? obj) 
           (> (vector-length obj) 0) 
           (equal? 'cyc-thread-obj (vector-ref obj 0))))

    (define (make-thread thunk . name)
      (let ((name-str (if (pair? name)
                          (car name)
                          "")))
        ;; Fields supported so far:
        ;; - type marker (implementation-specific)
        ;; - thunk
        ;; - internal thread id (implementation-specific)
        ;; - name
        ;; - specific
        (vector 'cyc-thread-obj thunk #f name-str #f)))

    (define (thread-name t) (vector-ref t 3))
    (define (thread-specific t) (vector-ref t 4))
    (define (thread-specific-set! t obj) (vector-set! t 4 obj))

    ; TODO:
    ; current-thread - not sure how to look this up yet... may need a global list of running threads. Unfortunately need the vector here

    (define (thread-start! t)
      ;; Initiate a GC prior to running the thread, in case
      ;; t contains any closures on the "parent" thread's stack
      (Cyc-minor-gc)
      (let* ((thunk (vector-ref t 1)) 
             (mutator-id (Cyc-spawn-thread! thunk)))
        (vector-set! t 2 mutator-id)))
    (define (thread-yield!) (thread-sleep! 1))
;    (define (thread-terminate!) (Cyc-end-thread!))
    ;; TODO: thread-join!

    (define-c thread-sleep!
      "(void *data, int argc, closure _, object k, object timeout)"
      " return_closcall1(data, k, Cyc_thread_sleep(data, timeout)); ")

    ;; Take a single object and if it is on the stack, return a copy
    ;; of it that is allocated on the heap. NOTE the original object
    ;; will still live on the stack, and will eventually be moved
    ;; itself to the heap if it is referenced during minor GC.
    (define-c ->heap
      "(void *data, int argc, closure _, object k, object obj)"
      " object heap_obj = copy2heap(data, obj);
        return_closcall1(data, k, heap_obj); ")
    ;; Trigger a minor garbage collection.
    ;; This is potentially useful to evacuate all objects from 
    ;; a thread's stack to the heap.
    (define-c Cyc-minor-gc
      "(void *data, int argc, closure _, object k)"
      " Cyc_trigger_minor_gc(data, k); ")

    (define-c condition-variable?
      "(void *data, int argc, closure _, object k, object obj)"
      " object result = Cyc_is_cond_var(obj);
        return_closcall1(data, k, result); ")
    ;; (make-condition-variable [name])                      ;procedure
;    (define-c make-condition-variable
;      "(void *data, int argc, closure _, object k)"
;      " int heap_grown;
;        cond_var cond;
;        cond_var_type tmp;
;        tmp.hdr.mark = gc_color_red;
;        tmp.hdr.grayed = 0;
;        tmp.tag = cond_var_tag;
;        cond = gc_alloc(Cyc_heap, sizeof(cond_var_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
;        if (pthread_cond_init(&(cond->cond), NULL) != 0) {
;          fprintf(stderr, "Unable to make condition variable\n");
;          exit(1);
;        }
;        return_closcall1(data, k, cond); ")
))
<commit_msg>Added signal and broadcast<commit_after>;;;; Cyclone Scheme
;;;; https://github.com/justinethier/cyclone
;;;;
;;;; Copyright (c) 2014-2016, <NAME>
;;;; All rights reserved.
;;;;
;;;; This module implements the multithreading API from SRFI 18.
;;;;
(define-library (srfi 18)
  (import (scheme base))
  (export
    ;; TODO: current-thread
    thread?
    make-thread
    thread-name
    thread-specific
    thread-specific-set!
    thread-start!
    thread-sleep!
    thread-yield!
    ;; TODO: thread-terminate!
    ;; TODO: thread-join!

    ;; For now, these are built-ins. No need to export them here: 
    ;; mutex?
    ;; make-mutex 
    ;; mutex-lock! 
    ;; mutex-unlock!

    ;; For now, these are not implemented:
    ;; mutex-name
    ;; mutex-specific
    ;; mutex-specific-set!
    ;; mutex-state

    ;; TODO: condition variables are not implemented yet
    condition-variable?
    make-condition-variable
    ;; (condition-variable-name condition-variable)          ;procedure
    ;; (condition-variable-specific condition-variable)      ;procedure
    ;; (condition-variable-specific-set! condition-variable obj) ;procedure
    condition-variable-signal!
    condition-variable-broadcast!

    ;; Time functions are not implemented here, see (scheme time) instead
   
    ;; Exceptions are not implemented here, r7rs exceptions are used instead

    ;; Non-standard functions:
    ->heap
    Cyc-minor-gc
  )
  (begin
    ;; Threading
    (define (thread? obj) 
      (and (vector? obj) 
           (> (vector-length obj) 0) 
           (equal? 'cyc-thread-obj (vector-ref obj 0))))

    (define (make-thread thunk . name)
      (let ((name-str (if (pair? name)
                          (car name)
                          "")))
        ;; Fields supported so far:
        ;; - type marker (implementation-specific)
        ;; - thunk
        ;; - internal thread id (implementation-specific)
        ;; - name
        ;; - specific
        (vector 'cyc-thread-obj thunk #f name-str #f)))

    (define (thread-name t) (vector-ref t 3))
    (define (thread-specific t) (vector-ref t 4))
    (define (thread-specific-set! t obj) (vector-set! t 4 obj))

    ; TODO:
    ; current-thread - not sure how to look this up yet... may need a global list of running threads. Unfortunately need the vector here

    (define (thread-start! t)
      ;; Initiate a GC prior to running the thread, in case
      ;; t contains any closures on the "parent" thread's stack
      (Cyc-minor-gc)
      (let* ((thunk (vector-ref t 1)) 
             (mutator-id (Cyc-spawn-thread! thunk)))
        (vector-set! t 2 mutator-id)))
    (define (thread-yield!) (thread-sleep! 1))
;    (define (thread-terminate!) (Cyc-end-thread!))
    ;; TODO: thread-join!

    (define-c thread-sleep!
      "(void *data, int argc, closure _, object k, object timeout)"
      " return_closcall1(data, k, Cyc_thread_sleep(data, timeout)); ")

    ;; Take a single object and if it is on the stack, return a copy
    ;; of it that is allocated on the heap. NOTE the original object
    ;; will still live on the stack, and will eventually be moved
    ;; itself to the heap if it is referenced during minor GC.
    (define-c ->heap
      "(void *data, int argc, closure _, object k, object obj)"
      " object heap_obj = copy2heap(data, obj);
        return_closcall1(data, k, heap_obj); ")
    ;; Trigger a minor garbage collection.
    ;; This is potentially useful to evacuate all objects from 
    ;; a thread's stack to the heap.
    (define-c Cyc-minor-gc
      "(void *data, int argc, closure _, object k)"
      " Cyc_trigger_minor_gc(data, k); ")

    (define-c condition-variable?
      "(void *data, int argc, closure _, object k, object obj)"
      " object result = Cyc_is_cond_var(obj);
        return_closcall1(data, k, result); ")
    ;; (make-condition-variable [name])                      ;procedure
    (define-c make-condition-variable
      "(void *data, int argc, closure _, object k)"
      " int heap_grown;
        cond_var cond;
        cond_var_type tmp;
        tmp.hdr.mark = gc_color_red;
        tmp.hdr.grayed = 0;
        tmp.tag = cond_var_tag;
        cond = gc_alloc(gc_get_heap(), sizeof(cond_var_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
        if (pthread_cond_init(&(cond->cond), NULL) != 0) {
          fprintf(stderr, \"Unable to make condition variable\\n\");
          exit(1);
        }
        return_closcall1(data, k, cond); ")
    ;; (condition-variable-signal! condition-variable)       ;procedure
    ;; (condition-variable-broadcast! condition-variable)    ;procedure
    (define-c condition-variable-signal!
      "(void *data, int argc, closure _, object k, object cond)"
      " Cyc_check_cond_var(data, cond);
        if (pthread_cond_signal(&(((cond_var)cond)->cond)) != 0) {
          fprintf(stderr, \"Unable to signal condition variable\\n\");
          exit(1);
        }
        return_closcall1(data, k, boolean_t); ")
    (define-c condition-variable-broadcast!
      "(void *data, int argc, closure _, object k, object cond)"
      " Cyc_check_cond_var(data, cond);
        if (pthread_cond_broadcast(&(((cond_var)cond)->cond)) != 0) {
          fprintf(stderr, \"Unable to broadcast condition variable\\n\");
          exit(1);
        }
        return_closcall1(data, k, boolean_t); ")
))

{'fraction_non_alphanumeric': 0.13122537630063644, 'fraction_numerical': 0.006465299525204566, 'mean_word_length': 2.5143769968051117, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 15, 'https://': 2, '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': '1139763', 'n_tokens_mistral': 3179, 'n_tokens_neox': 2954, 'n_words': 905}