Changeset 36192 in project


Ignore:
Timestamp:
08/11/18 22:56:13 (13 months ago)
Author:
Kon Lovett
Message:

C5 port

Location:
release/5/mailbox/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/5/mailbox/trunk/mailbox.egg

    r36012 r36192  
    1 ;;; mailbox.meta -*- Hen -*-
     1;;; mailbox.egg  -*- Scheme -*-
     2;;;; Kon Lovett, Jul '18
    23
    3 ((egg "mailbox.egg")
    4  (synopsis "Thread-safe queues with timeout")
     4((synopsis "Thread-safe queues with timeout")
    55 (category hell)
     6 (version "3.0.0")
    67 (author "[[felix winkelman]] and [[kon lovett]]")
    78 (license "BSD")
    8  (doc-from-wiki)
    9  (depends
    10         (setup-helper "1.5.2")
    11         (check-errors "1.12.5")
    12         (condition-utils "1.0.0")
    13         (record-variants "0.5"))
    14 
    15 
    16 (setup-shared+static-extension-module 'mailbox (extension-version "2.3.1")
    17   #:inline? #t
    18   #:types? #t
    19   #:compile-options '(
    20     -scrutinize
    21     -feature unsafe-operations
    22     -feature sleep-primordial-thread
    23     -optimize-level 3 -debug-level 1
    24     -no-procedure-checks -no-bound-checks -no-argc-checks))
     9 (dependencies
     10        (srfi-1 "0.2")
     11        (srfi-18 "0.1")
     12        (check-errors "3.1.0")
     13        (condition-utils "2.1.0")
     14        (record-variants "1.0"))
     15 (test-dependencies test)
     16 (components
     17  (extension mailbox
     18    #;(inline-file)
     19    (types-file)
     20    (csc-options
     21      "-feature" "unsafe-operations"
     22      "-feature" "sleep-primordial-thread"
     23      "-O3" "-d1"
     24      "-local"
     25      "-no-procedure-checks" "-no-bound-checks" "-no-argc-checks") ) ) )
  • release/5/mailbox/trunk/mailbox.scm

    r36012 r36192  
    2424;; - Probably should be rewritten to use a mutex & condition-variable rather than
    2525;; disabling interrupts and having own thread waiting queue.
     26
     27(declare
     28  (disable-interrupts) ;A MUST!
     29  (always-bound ##sys#primordial-thread)
     30  (bound-to-procedure
     31    ##sys#signal-hook
     32    ##sys#thread-unblock!) )
    2633
    2734(module mailbox
     
    5360  mailbox-cursor-extract-and-rewind!)
    5461
    55 (import scheme chicken)
    56 
    57 (use
    58   (only ports with-output-to-port)
    59   (only extras format)
    60   (only srfi-1
    61     append! delete! list-copy last-pair)
    62   (only srfi-18
     62(import scheme
     63  (chicken base)
     64  (chicken syntax)
     65  (chicken condition)
     66  (chicken type)
     67  (only (chicken port) with-output-to-port)
     68  (only (chicken format) format)
     69  (only (srfi 1) append! delete! list-copy last-pair)
     70  (only (srfi 18)
    6371    current-thread
    6472    thread-signal! thread-sleep!
     
    6674    time?)
    6775  (only type-errors define-error-type error-list)
    68   (only condition-utils make-exn-condition+ make-condition-predicate)
     76  (only condition-utils make-condition-predicate)
     77  (only exn-condition make-exn-condition+)
    6978  record-variants )
    70 
    71 ;yes, yes, not a module form
    72 (declare
    73   (disable-interrupts) ;A MUST!
    74   (always-bound ##sys#primordial-thread)
    75   (bound-to-procedure
    76     ##sys#signal-hook
    77     ##sys#thread-unblock!) )
    7879
    7980;;; Primitives
  • release/5/mailbox/trunk/tests/mailbox-cursor-test.scm

    r36012 r36192  
    33;;;
    44
    5 (use mailbox)
    6 (use srfi-18)
     5(import mailbox)
     6(import srfi-18)
    77
    88;;; Test support
  • release/5/mailbox/trunk/tests/mailbox-primordial-test.scm

    r36012 r36192  
     1;
     2(import (chicken condition))
     3
     4(define (maybe-condition->list exn)
     5  (or
     6    (and (condition? exn) (condition->list exn))
     7    exn) )
     8
    19;from caolan
    210
     
    412(print "** Test Primordial Waiting **")
    513
    6 (use srfi-18 mailbox)
     14(import srfi-18 mailbox)
    715
    816(define mbox (make-mailbox))
    9 (define primordial (current-thread))
    1017
    11 (define t (thread-start! (lambda ()
    12                            (thread-sleep! 1)
    13                            (thread-signal! primordial 'example))))
     18(define primordial ##sys#primordial-thread #;(current-thread))
     19
     20(define (tst-thd)
     21  (thread-sleep! 1)
     22  (thread-signal! primordial 'example) )
     23
     24(define tst-thd-1 (thread-start! tst-thd))
    1425
    1526#; ;; this hangs forever and eats all my cycles (with timeout)
    1627(handle-exceptions exn
    17   (print "+ wait with timeout NOT OK for primordial thread: " (condition->list exn))
     28  (print "+ wait with timeout NOT OK for primordial thread: " (maybe-condition->list exn))
    1829  (mailbox-receive! mbox 4) )
    1930
    2031;; this exits as expected with the 'example exception (no timeout)
    2132(handle-exceptions exn
    22   (print
    23     "+ wait with no timeout OK for primordial thread: "
    24     (if (condition? exn) (condition->list exn) exn))
     33  (print "+ wait with no timeout OK for primordial thread: " (maybe-condition->list exn))
    2534  (mailbox-receive! mbox) )
  • release/5/mailbox/trunk/tests/reader-writer-test.scm

    r36012 r36192  
    33;;;
    44
    5 (use mailbox)
    6 (use srfi-18)
     5(import mailbox)
     6(import srfi-18)
    77
    88;;; Test support
  • release/5/mailbox/trunk/tests/run.scm

    r36012 r36192  
    44;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    55
    6 (use files)
     6(import
     7  (only (chicken pathname) make-pathname)
     8  (only (chicken process) system)
     9  (only (chicken process-context) argv)
     10  (only (chicken format) format))
     11
     12(define *args* (argv))
    713
    814;no -disable-interrupts
    9 (define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
    10 
    11 (define *args* (argv))
     15(define *csc-options* "-inline-global \
     16  -specialize -optimize-leaf-routines -clustering -lfa2 \
     17  -local -inline \
     18  -no-trace -no-lambda-info \
     19  -unsafe")
    1220
    1321(define (test-name #!optional (eggnam EGG-NAME))
     
    2937(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    3038  (let ((tstnam (test-name eggnam)))
    31     (print "*** csi ***")
     39    (format #t "*** csi ***~%")
    3240    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    3341    (newline)
    34     (print "*** csc (" cscopts ") ***")
     42    (format #t "*** csc ~s ***~%" cscopts)
    3543    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    3644    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
Note: See TracChangeset for help on using the changeset viewer.