adding join-timeout-exception?

lib/chibi/ast.c

@@ -187,6 +187,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_define_type(ctx, "<lit>", SEXP_LIT);
   sexp_define_type(ctx, "<sc>", SEXP_SYNCLO);
   sexp_define_type(ctx, "<context>", SEXP_CONTEXT);
+  sexp_define_type(ctx, "<exception>", SEXP_EXCEPTION);
   sexp_define_type_predicate(ctx, env, "environment?", SEXP_ENV);
   sexp_define_type_predicate(ctx, env, "bytecode?", SEXP_BYTECODE);
   sexp_define_type_predicate(ctx, env, "exception?", SEXP_EXCEPTION);
@@ -201,6 +202,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_define_type_predicate(ctx, env, "opcode?", SEXP_OPCODE);
   sexp_define_type_predicate(ctx, env, "type?", SEXP_TYPE);
   sexp_define_type_predicate(ctx, env, "context?", SEXP_CONTEXT);
+  sexp_define_type_predicate(ctx, env, "exception?", SEXP_EXCEPTION);
   sexp_define_accessors(ctx, env, SEXP_PAIR, 2, "pair-source", "pair-source-set!");
   sexp_define_accessors(ctx, env, SEXP_SYNCLO, 0, "syntactic-closure-env", "syntactic-closure-env-set!");
   sexp_define_accessors(ctx, env, SEXP_SYNCLO, 1, "syntactic-closure-vars", "syntactic-closure-vars-set!");
@@ -228,6 +230,9 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_define_accessors(ctx, env, SEXP_PROCEDURE, 1, "procedure-code", "procedure-code-set!");
   sexp_define_accessors(ctx, env, SEXP_PROCEDURE, 2, "procedure-vars", "procedure-vars-set!");
   sexp_define_accessors(ctx, env, SEXP_BYTECODE, 1, "bytecode-name", "bytecode-name-set!");
+  sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 0, "exception-kind", "exception-kind-set!");
+  sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 1, "exception-message", "exception-message-set!");
+  sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 2, "exception-irritants", "exception-irritants-set!");
   sexp_define_foreign_opt(ctx, env, "analyze", 2, sexp_analyze_op, SEXP_FALSE);
   sexp_define_foreign(ctx, env, "extend-env", 2, sexp_extend_env);
   sexp_define_foreign(ctx, env, "env-cell", 2, sexp_get_env_cell);

lib/chibi/ast.module

@@ -5,10 +5,10 @@
    <object> <opcode> <procedure> <bytecode> <macro> <env>
    <number> <bignum> <flonum> <integer> <char> <boolean>
    <symbol> <string> <byte-vector> <vector> <pair>
-   <context> <lam> <cnd> <set> <ref> <seq> <lit> <sc>
+   <context> <lam> <cnd> <set> <ref> <seq> <lit> <sc> <exception>
    pair-source pair-source-set!
    syntactic-closure? lambda? cnd? set? ref? seq? lit? opcode? type?
-   environment? bytecode? exception? macro? context?
+   environment? bytecode? exception? macro? context? exception?
    syntactic-closure-expr syntactic-closure-env syntactic-closure-vars
    lambda-name lambda-params lambda-body lambda-defs lambda-locals
    lambda-flags lambda-free-vars lambda-set-vars lambda-return-type
@@ -22,6 +22,8 @@
    set-var set-value set-var-set! set-value-set!
    ref-name ref-cell ref-name-set! ref-cell-set!
    seq-ls seq-ls-set! lit-value lit-value-set!
+   exception-kind exception-kind-set! exception-message exception-message-set!
+   exception-irritants exception-irritants-set!
    opcode-name opcode-num-params opcode-return-type opcode-param-type
    opcode-variadic?
    procedure-code procedure-vars procedure-name bytecode-name)

lib/srfi/18.module

@@ -17,6 +17,7 @@
    uncaught-exception-reason)
   (import-immutable (scheme)
                     (srfi 9)
+                    (chibi ast)
                     (chibi time))
   (include-shared "18/threads")
   (include "18/types.scm" "18/interface.scm"))

lib/srfi/18/interface.scm

@@ -37,3 +37,13 @@
 
 (define current-time get-time-of-day)
 (define time? timeval?)
+
+(define (join-timeout-exception? x)
+  (and (exception? x)
+       (equal? (exception-message x) "timed out waiting for thread")))
+
+;; flush out exception types
+(define (abandoned-mutex-exception? x) #f)
+(define (terminated-thread-exception? x) #f)
+(define (uncaught-exception? x) #f)
+(define (uncaught-exception-reason x) #f)