Commit 1f404705 authored by Erick Gallesio's avatar Erick Gallesio

added SRFI-18

parent 563037be
2006-10-25 Erick Gallesio <eg@essi.fr>
* lib/srfi-0.stk: Fully srfi-18 compliant.
2006-10-20 Erick Gallesio <eg@essi.fr>
* src/stklos.c (main): FIXED: open file ports were not flushed on
......
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio [eg@unice.fr]
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 20-Apr-2005 20:56 (eg)
;; Last file update: 25-Oct-2006 19:54 (eg)
;;
;; ======================================================================
......@@ -58,7 +58,8 @@ exception handler.])
(insertdoc 'with-handler)
(insertdoc 'with-exception-handler)
(insertdoc 'raise)
(insertdoc 'guard))
(insertdoc 'guard)
(insertdoc 'current-exception-handler))
(section :title "Conditions"
......
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio [eg@unice.fr]
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 3-Jan-2006 16:18 (eg)
;; Last file update: 25-Oct-2006 17:40 (eg)
;;
;; ======================================================================
......@@ -220,7 +220,16 @@ described in this document (procedures ,(code "set!") and
(p [in your code (or the use of the ,(code "cond-expand") special form) permits
to define the setters for the (numerous) cXXXXr list procedures.]))
;; ----------------------------------------------------------------------
;; SRFI 18 -- Multithreading support
;; ----------------------------------------------------------------------
(index "thread")
(index "mutex")
(index "condition-variable")
(srfi-section 18
(p [,(quick-link-srfi 18) is fully supported and is completely
described in this document]))
;; ----------------------------------------------------------------------
;; SRFI 19 -- Time Data Types and Procedures
;; ----------------------------------------------------------------------
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Feb-2000 10:47 (eg)
;;;; Last file update: 27-Sep-2006 12:35 (eg)
;;;; Last file update: 25-Oct-2006 16:48 (eg)
;;;;
;;(define-module new-compiler
......
;;;;
;;;; srfi-0.stk -- SRFI-0 aka cond-expand
;;;;
;;;; Copyright 1999-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright 1999-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 30-Aug-1999 16:26 (eg)
;;;; Last file update: 15-Dec-2005 20:24 (eg)
;;;; Last file update: 25-Oct-2006 17:37 (eg)
;;;;
; (select-module Scheme) ;//FIXME:
......@@ -47,7 +47,7 @@
;; srfi-15 ; ....... withdrawn
((srfi-16 case-lambda)) ; CASE-LAMBDA
srfi-17 ; Generalized set!
;; srfi-18 ; Multithreading support
srfi-18 ; Multithreading support
;; (srfi-19 "srfi-19") ; Time Data Types and Procedures
;; srfi-20 ; ....... withdrawn
;; srfi-21 ; Real-time multithreading support
......@@ -76,17 +76,17 @@
;; srfi-43 ; Vector library
;; srfi-44 ; Collections
;; srfi-45 ; primitives for lazy algorithms
;; srfi-46
;; srfi-46 ; Basic Syntax-rules Extensions
;; srfi-47 ; Array
srfi-48 ; Intermediate Format Strings
;; srfi-49 ; Indentation-sensitive syntax (NEVER)
;; srfi-50
;; srfi-50 ; ....... withdrawn
;; srfi-51 ; Handling rest list
;; srfi-52 ; ....... withdrawn
;; srfi-53 ; ....... withdrawn
;; srfi-54 ; Formatting
srfi-55 ; require-extension
;; srfi-56
;; srfi-56 ; ....... withdrawn
;; srfi-57 ; Records
;; srfi-58 ; Array Notation
;; srfi-59 ; Vicinity
......@@ -94,15 +94,38 @@
;; srfi-61 ; A more general cond clause
srfi-62 ; S-expression comments
;; srfi-63 ; Homogeneous and Heterogeneous Arrays
;; srfi-64
;; srfi-65
;; srfi-64 ; A Scheme API for test suites
;; srfi-65 ; ....... withdrawn
(srfi-66 "srfi-66") ; Octet Vectors
;; srfi-67 ; Compare Procedures
;; srfi-68
;; srfi-68 ; ....... withdrawn
((srfi-69 hash-tables) "srfi-69") ; Basic Hash Tables
srfi-70 ; Numbers
;; srfi-71 ; LET-syntax for multiple values
;; srfi-72 ; Simple hygienic macros
;; srfi-73 ; ....... withdrawn
;; srfi-74 ; Octet-Addressed Binary Blocks
;; srfi-75 ; ....... withdrawn
;; srfi-76 ; ....... withdrawn
;; srfi-77 ; ....... withdrawn
;; srfi-78 ; Lightweight testing
;; srfi-79
;; srfi-80
;; srfi-81
;; srfi-82
;; srfi-83 ; ....... withdrawn
;; srfi-84
;; srfi-85 ; ....... withdrawn
;; srfi-86
;; srfi-87 ; => in case clauses
;; srfi-88
;; srfi-89
;; srfi-90
;; srfi-91
;; srfi-92
;; srfi-93 ; ....... withdrawn
;; srfi-94
;; srfi-95
))
(define (%has-feature? x)
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 26-Jan-2006 22:56 (eg)
;;;; Last file update: 25-Oct-2006 15:43 (eg)
;;;; Last file update: 25-Oct-2006 17:06 (eg)
;;;;
(define (%thread-timeout->seconds timeout)
(cond
......@@ -91,7 +91,6 @@ doc>
(raise (make-condition &thread-join-timeout))))
((%thread-end-exception thread)
;; We had an exception in thread. Raise an uncaught-exception
(eprintf "FOOOOO\n")
(let ((old-exception (%thread-end-exception thread)))
(raise (make-condition &uncaught-exception
'reason old-exception))))
......@@ -133,10 +132,21 @@ doc>
(%define-condition-type-accessors &thread-terminated &condition
terminated-thread-exception?)
(define &uncaught-exception
(make-condition-type '&uncaught-execption
&condition
'(reason)))
;; The following definitions correspond to the macro-expansion of the form
;;
;; (define-condition-type &uncaught-exception &condition
;; &uncaught-exception?
;; (reason uncaught-exception-reason))
::
;; Using the macro-expansion avoid the auto-loading of SRFI-35
(define &uncaught-exception (make-condition-type '&uncaught-exception
&condition
'(reason)))
(%define-condition-type-accessors &uncaught-exception &condition
uncaught-exception?
(reason uncaught-exception-reason))
#|
<doc EXT join-timeout-exception?
......
This diff is collapsed.
This diff is collapsed.
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 24-Oct-2006 17:18 (eg)
* Last file update: 25-Oct-2006 19:57 (eg)
*/
// INLINER values
......@@ -1538,6 +1538,25 @@ void STk_raise_exception(SCM cond)
MY_LONGJMP(*(vm->top_jmp_buf), 1);
}
/*
<doc EXT current-exception-handler
* (current-exception-handler)
*
* Returns the current exception handler. This procedure is defined in
* ,(link-srfi 18).
doc>
*/
DEFINE_PRIMITIVE("current-exception-handler", current_handler, subr0, (void))
{
vm_thread_t *vm = STk_get_current_vm();
if (vm->handlers == NULL)
return STk_false;
else
return (SCM) HANDLER_PROC(vm->handlers);
}
/*===========================================================================*\
*
* C O N T I N U A T I O N S
......@@ -1709,6 +1728,7 @@ static struct extended_type_descr xtype_continuation = {
#endif /* ! THREADS_LURC */
/*===========================================================================*\
*
* Bytecode file dump/load stuff
......@@ -1906,6 +1926,9 @@ int STk_init_vm()
ADD_PRIMITIVE(values);
ADD_PRIMITIVE(call_with_values);
ADD_PRIMITIVE(current_handler);
#ifndef THREADS_LURC
ADD_PRIMITIVE(make_continuation);
ADD_PRIMITIVE(restore_cont);
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 16-Apr-2006 12:54 (eg)
;;;; Last file update: 25-Oct-2006 14:17 (eg)
;;;; Last file update: 25-Oct-2006 17:21 (eg)
;;;;
;;;; Most of theses tests were stolen in Gauche Scheme distribution
......@@ -107,11 +107,14 @@
123)
(thread-join! t))))
(test "uncaught-exception.2" 42
(let ((t (make-thread (lambda () (raise 4)))))
(thread-start! t)
(with-handler (lambda (c) (+ c 38))
(thread-join! t))))
(test "uncaught-exception.2"
1230
(let ((t (thread-start! (make-thread (lambda () (raise 123))))))
(with-handler (lambda (exc)
(if (uncaught-exception? exc)
(* 10 (uncaught-exception-reason exc))
99999))
(+ 1 (thread-join! t)))))
;;------------------------------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment