From 3d3338c678425f96c45f0994f01a562a5b6d6afe Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 7 May 2017 16:45:16 +0200
Subject: [PATCH 1/2] Add chicken.condition module

---
 README                |   1 +
 chicken-install.scm   |   1 +
 chicken-syntax.scm    |   7 +-
 chicken.import.scm    |  26 +++---
 core.scm              |   1 +
 csi.scm               |   1 +
 data-structures.scm   |   5 +-
 defaults.make         |   8 +-
 distribution/manifest |   2 +
 eval.scm              |   2 +-
 expand.scm            |   3 +-
 library.scm           | 252 +++++++++++++++++++++++++++-----------------------
 modules.scm           |  12 ++-
 posixunix.scm         |   1 +
 posixwin.scm          |   1 +
 rules.make            |  10 ++
 scheduler.scm         |   2 +-
 support.scm           |   1 +
 types.db              |  42 ++++-----
 19 files changed, 211 insertions(+), 167 deletions(-)

diff --git a/README b/README
index 27db7bb..2047a8d 100644
--- a/README
+++ b/README
@@ -286,6 +286,7 @@ _/        _/    _/    _/    _/        _/  _/    _/        _/    _/_/
 	|   |       |-- chicken.import.so
 	|   |       |-- chicken.bitwise.import.so
 	|   |       |-- chicken.compiler.user-pass.import.so
+	|   |       |-- chicken.condition.import.so
 	|   |       |-- chicken.continuation.import.so
 	|   |       |-- chicken.csi.import.so
 	|   |       |-- chicken.data-structures.import.so
diff --git a/chicken-install.scm b/chicken-install.scm
index 05f2600..0e56b0e 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -28,6 +28,7 @@
 
 (import (scheme))
 (import (chicken))
+(import (chicken condition))
 (import (chicken foreign))
 (import (chicken data-structures))
 (import (chicken keyword))
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 65367b8..a69721f 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -873,8 +873,7 @@
 
 (##sys#extend-macro-environment
  'handle-exceptions 
- `((call-with-current-continuation . ,(##sys#primitive-alias 'call-with-current-continuation))
-   (with-exception-handler . ,(##sys#primitive-alias 'with-exception-handler)))
+ `((call-with-current-continuation . ,(##sys#primitive-alias 'call-with-current-continuation)))
  (##sys#er-transformer
   (lambda (form r c)
     (##sys#check-syntax 'handle-exceptions form '(_ variable _ . _))
@@ -883,7 +882,7 @@
       `((,(r 'call-with-current-continuation)
 	 (##core#lambda
 	  (,k)
-	  (,(r 'with-exception-handler)
+	  (chicken.condition#with-exception-handler
 	   (##core#lambda (,(cadr form)) (,k (##core#lambda () ,(caddr form))))
 	   (##core#lambda
 	    ()
@@ -925,7 +924,7 @@
 			 ,@clauses
 			 ,@(if (assq %else clauses)
 			       `()   ; Don't generate two else clauses
-			       `((,%else (##sys#signal ,exvar)))) )) )
+			       `((,%else (chicken.condition#signal ,exvar)))) )) )
 	,(cadr form))))))
 
 
diff --git a/chicken.import.scm b/chicken.import.scm
index b19e72b..3ebc9c9 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -26,7 +26,7 @@
 
 (##sys#register-primitive-module
  'chicken
- '(abort
+ '((abort . chicken.condition#abort)
    add1
    argc+argv
    argv
@@ -42,13 +42,13 @@
    (chicken-home . chicken.platform#chicken-home)
    (chicken-version . chicken.platform#chicken-version)
    command-line-arguments
-   condition-predicate
-   condition-property-accessor
-   condition?
-   condition->list
+   (condition-predicate . chicken.condition#condition-predicate)
+   (condition-property-accessor . chicken.condition#condition-property-accessor)
+   (condition? . chicken.condition#condition?)
+   (condition->list . chicken.condition#condition->list)
    cplxnum?
    current-error-port
-   current-exception-handler
+   (current-exception-handler . chicken.condition#current-exception-handler)
    current-read-table
    delete-file
    directory-exists?
@@ -105,8 +105,8 @@
    (fxlen . chicken.fixnum#fxlen)
    gensym
    get
-   get-call-chain
-   get-condition-property
+   (get-call-chain . chicken.condition#get-call-chain)
+   (get-condition-property . chicken.condition#get-condition-property)
    get-environment-variable
    (get-line-number . chicken.expand#get-line-number)
    get-output-string
@@ -126,10 +126,10 @@
    (machine-byte-order . chicken.platform#machine-byte-order)
    (machine-type . chicken.platform#machine-type)
    make-blob
-   make-composite-condition
+   (make-composite-condition . chicken.condition#make-composite-condition)
    make-parameter
    make-promise
-   make-property-condition
+   (make-property-condition . chicken.condition#make-property-condition)
    module-environment
    (most-negative-fixnum . chicken.fixnum#most-negative-fixnum)
    (most-positive-fixnum . chicken.fixnum#most-positive-fixnum)
@@ -147,7 +147,7 @@
    (provide . chicken.load#provide)
    (provided? . chicken.load#provided?)
    print
-   print-call-chain
+   (print-call-chain . chicken.condition#print-call-chain)
    print-error-message
    print*
    procedure-information
@@ -169,7 +169,7 @@
    reverse-list->string
    set-port-name!
    setter
-   signal
+   (signal . chicken.condition#signal)
    signum
    singlestep
    sleep
@@ -190,5 +190,5 @@
    vector-copy!
    void
    warning
-   with-exception-handler)
+   (with-exception-handler . chicken.condition#with-exception-handler))
  ##sys#chicken-macro-environment)       ;XXX incorrect - won't work in compiled executable that does expansion
diff --git a/core.scm b/core.scm
index 8f68e3f..4d05fd8 100644
--- a/core.scm
+++ b/core.scm
@@ -322,6 +322,7 @@
      line-number-database-size)
 
 (import chicken scheme
+	chicken.condition
 	chicken.compiler.scrutinizer
 	chicken.compiler.support
 	chicken.data-structures
diff --git a/csi.scm b/csi.scm
index 72defb8..d03c169 100644
--- a/csi.scm
+++ b/csi.scm
@@ -45,6 +45,7 @@ EOF
   (editor-command toplevel-command set-describer!)
 
 (import chicken scheme
+	chicken.condition
 	chicken.data-structures
 	chicken.foreign
 	chicken.format
diff --git a/data-structures.scm b/data-structures.scm
index 0a6ea24..bf9821b 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -44,6 +44,7 @@
 
 (import scheme chicken)
 (import chicken.foreign)
+(import chicken.condition)
 
 (include "common-declarations.scm")
 
@@ -748,13 +749,13 @@
   (define (visit dag node edges path state)
     (case (alist-ref node (car state) pred)
       ((grey)
-       (##sys#abort
+       (abort
         (##sys#make-structure
          'condition
          '(exn runtime cycle)
          `((exn . message) "cycle detected"
            (exn . arguments) ,(list (cons node (reverse path)))
-           (exn . call-chain) ,(##sys#get-call-chain)
+           (exn . call-chain) ,(get-call-chain)
            (exn . location) topological-sort))))
       ((black)
        state)
diff --git a/defaults.make b/defaults.make
index bc66d78..bf3258f 100644
--- a/defaults.make
+++ b/defaults.make
@@ -265,10 +265,10 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
 
 PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.csi chicken.foreign
 DYNAMIC_IMPORT_LIBRARIES = srfi-4
-DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix fixnum flonum \
-	format gc io keyword load locative memory platform posix \
-	pretty-print process process.signal process-context random \
-	time time.posix
+DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise condition errno file.posix	\
+	fixnum flonum format gc io keyword load locative memory		\
+	platform posix pretty-print process process.signal		\
+	process-context random time time.posix
 DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
 DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
 	eval expand file files internal irregex lolevel pathname port \
diff --git a/distribution/manifest b/distribution/manifest
index 7e9c3ad..69b8178 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -267,6 +267,8 @@ chicken.bitwise.import.scm
 chicken.bitwise.import.c
 chicken.compiler.user-pass.import.scm
 chicken.compiler.user-pass.import.c
+chicken.condition.import.scm
+chicken.condition.import.c
 chicken.continuation.import.scm
 chicken.continuation.import.c
 chicken.csi.import.scm
diff --git a/eval.scm b/eval.scm
index 9fb27da..859cfba 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1374,7 +1374,7 @@
 
 ;;; Simple invocation API:
 
-(import chicken chicken.eval chicken.load)
+(import chicken chicken.eval chicken.load chicken.condition)
 
 (declare
   (hide last-error run-safe store-result store-string
diff --git a/expand.scm b/expand.scm
index 4397d22..937e899 100644
--- a/expand.scm
+++ b/expand.scm
@@ -52,6 +52,7 @@
    expansion-result-hook)
 
 (import scheme chicken
+	chicken.condition
 	chicken.internal
 	chicken.keyword
 	chicken.platform)
@@ -225,7 +226,7 @@
     (handle-exceptions ex
 	;; modify error message in condition object to include 
 	;; currently expanded macro-name
-	(##sys#abort
+	(abort
 	 (if (and (##sys#structure? ex 'condition)
 		  (memv 'exn (##sys#slot ex 1)) )
 	     (##sys#make-structure
diff --git a/library.scm b/library.scm
index 2b98ae9..e13916e 100644
--- a/library.scm
+++ b/library.scm
@@ -4383,72 +4383,6 @@ EOF
 	  (string-append "#<pointer 0x" (##sys#number->string (##sys#pointer->address x) 16) ">") ) ) ) )
 
 
-;;; Access backtrace:
-
-(define-constant +trace-buffer-entry-slot-count+ 4)
-
-(define get-call-chain
-  (let ((extract
-	 (foreign-lambda* nonnull-c-string ((scheme-object x)) "C_return((C_char *)x);")))
-    (lambda (#!optional (start 0) (thread ##sys#current-thread))
-      (let* ((tbl (foreign-value "C_trace_buffer_size" int))
-	     ;; 4 slots: "raw" string, cooked1, cooked2, thread
-	     (c +trace-buffer-entry-slot-count+)
-	     (vec (##sys#make-vector (fx* c tbl) #f))
-	     (r (##core#inline "C_fetch_trace" start vec)) 
-	     (n (if (fixnum? r) r (fx* c tbl))) )
-	(let loop ((i 0))
-	  (if (fx>= i n) 
-	      '()
-	      (let ((t (##sys#slot vec (fx+ i 3)))) ; thread
-		(if (or (not t) (not thread) (eq? thread t))
-		    (cons (vector
-			   (extract (##sys#slot vec i)) ; raw
-			   (##sys#slot vec (fx+ i 1))   ; cooked1
-			   (##sys#slot vec (fx+ i 2)) ) ; cooked2
-			  (loop (fx+ i c)) )
-		    (loop (fx+ i c))) ) ) ) ) ) ) )
-
-(define (##sys#really-print-call-chain port chain header)
-  (when (pair? chain)
-    (##sys#print header #f port)
-    (for-each
-     (lambda (info) 
-       (let* ((more1 (##sys#slot info 1)) ; cooked1 (expr/form)
-	      (more2 (##sys#slot info 2)) ; cooked2 (cntr/frameinfo)
-	      (fi (##sys#structure? more2 'frameinfo)))
-	 (##sys#print "\n\t" #f port)
-	 (##sys#print (##sys#slot info 0) #f port) ; raw (mode)
-	 (##sys#print "\t  " #f port)
-	 (when (and more2 (if fi (##sys#slot more2 1)))
-	   (##sys#write-char-0 #\[ port)
-	   (##sys#print 
-	    (if fi
-		(##sys#slot more2 1)	; cntr
-		more2)
-	    #f port)
-	   (##sys#print "] " #f port) )
-	 (when more1
-	   (##sys#with-print-length-limit
-	    100
-	    (lambda ()
-	      (##sys#print more1 #t port) ) ) ) ) )
-     chain)
-    (##sys#print "\t<--\n" #f port) ) )
-
-(define (print-call-chain #!optional (port ##sys#standard-output) (start 0)
-				     (thread ##sys#current-thread)
-				     (header "\n\tCall history:\n") )
-  (##sys#check-output-port port #t 'print-call-chain)
-  (##sys#check-fixnum start 'print-call-chain)
-  (##sys#check-string header 'print-call-chain)
-  (let ((ct (##sys#get-call-chain start thread)))
-    (##sys#really-print-call-chain port ct header)
-    ct))
-
-(define ##sys#get-call-chain get-call-chain)
-
-
 ;;; Interrupt handling:
 
 (define (##sys#user-interrupt-hook)
@@ -4460,46 +4394,6 @@ EOF
 
 ;;; Default handlers
 
-(define ##sys#break-on-error (foreign-value "C_enable_repl" bool))
-
-(define-foreign-variable _ex_software int "EX_SOFTWARE")
-
-(define ##sys#error-handler
-  (make-parameter
-   (let ([string-append string-append])
-     (lambda (msg . args)
-       (##sys#error-handler (lambda args (##core#inline "C_halt" "error in error")))
-       (cond ((not (foreign-value "C_gui_mode" bool))
-	      (##sys#print "\nError" #f ##sys#standard-error)
-	      (when msg
-		(##sys#print ": " #f ##sys#standard-error)
-		(##sys#print msg #f ##sys#standard-error) )
-	      (##sys#with-print-length-limit
-	       400
-	       (lambda ()
-		 (cond [(fx= 1 (length args))
-			(##sys#print ": " #f ##sys#standard-error)
-			(##sys#print (##sys#slot args 0) #t ##sys#standard-error)]
-		       [else
-			(##sys#for-each
-			 (lambda (x)
-			   (##sys#print #\newline #f ##sys#standard-error)
-			   (##sys#print x #t ##sys#standard-error))
-			 args)])))
-	      (##sys#print #\newline #f ##sys#standard-error)
-	      (print-call-chain ##sys#standard-error)
-	      (when (and ##sys#break-on-error (##sys#symbol-has-toplevel-binding? 'chicken.repl#repl))
-		(chicken.repl#repl)
-		(##sys#print #\newline #f ##sys#standard-error)
-		(##core#inline "C_exit_runtime" _ex_software) )
-	      (##core#inline "C_halt" #f) )
-	     (else
-	      (let ((out (open-output-string)))
-		(when msg (##sys#print msg #f out))
-		(##sys#print #\newline #f out)
-		(##sys#for-each (lambda (x) (##sys#print x #t out) (##sys#print #\newline #f out)) args)
-		(##core#inline "C_halt" (get-output-string out)) ) ) ) ) ) ) )
-
 (define reset-handler 
   (make-parameter 
    (lambda ()
@@ -4553,15 +4447,90 @@ EOF
 
 ;;; Condition handling:
 
-(define (##sys#debugger msg . args)
-  (##core#inline "signal_debug_event" #:debugger-invocation msg args) )
+(module chicken.condition
+    (abort signal current-exception-handler get-call-chain
+     print-call-chain with-exception-handler
+
+     ;; Condition object manipulation
+     make-property-condition make-composite-condition condition?
+     condition->list condition-predicate condition-property-accessor
+     get-condition-property)
+
+(import scheme)
+(import chicken.fixnum)
+(import chicken.foreign)
+(import (only chicken get-output-string open-output-string
+	      define-constant when fixnum? let-optionals make-parameter))
+
+;;; Access backtrace:
+
+(define-constant +trace-buffer-entry-slot-count+ 4)
+
+(define get-call-chain
+  (let ((extract
+	 (foreign-lambda* nonnull-c-string ((scheme-object x)) "C_return((C_char *)x);")))
+    (lambda (#!optional (start 0) (thread ##sys#current-thread))
+      (let* ((tbl (foreign-value "C_trace_buffer_size" int))
+	     ;; 4 slots: "raw" string, cooked1, cooked2, thread
+	     (c +trace-buffer-entry-slot-count+)
+	     (vec (##sys#make-vector (fx* c tbl) #f))
+	     (r (##core#inline "C_fetch_trace" start vec))
+	     (n (if (fixnum? r) r (fx* c tbl))) )
+	(let loop ((i 0))
+	  (if (fx>= i n)
+	      '()
+	      (let ((t (##sys#slot vec (fx+ i 3)))) ; thread
+		(if (or (not t) (not thread) (eq? thread t))
+		    (cons (vector
+			   (extract (##sys#slot vec i)) ; raw
+			   (##sys#slot vec (fx+ i 1))   ; cooked1
+			   (##sys#slot vec (fx+ i 2)) ) ; cooked2
+			  (loop (fx+ i c)) )
+		    (loop (fx+ i c))) ) ) ) ) ) ) )
+
+(define (##sys#really-print-call-chain port chain header)
+  (when (pair? chain)
+    (##sys#print header #f port)
+    (for-each
+     (lambda (info)
+       (let* ((more1 (##sys#slot info 1)) ; cooked1 (expr/form)
+	      (more2 (##sys#slot info 2)) ; cooked2 (cntr/frameinfo)
+	      (fi (##sys#structure? more2 'frameinfo)))
+	 (##sys#print "\n\t" #f port)
+	 (##sys#print (##sys#slot info 0) #f port) ; raw (mode)
+	 (##sys#print "\t  " #f port)
+	 (when (and more2 (if fi (##sys#slot more2 1)))
+	   (##sys#write-char-0 #\[ port)
+	   (##sys#print
+	    (if fi
+		(##sys#slot more2 1)	; cntr
+		more2)
+	    #f port)
+	   (##sys#print "] " #f port) )
+	 (when more1
+	   (##sys#with-print-length-limit
+	    100
+	    (lambda ()
+	      (##sys#print more1 #t port) ) ) ) ) )
+     chain)
+    (##sys#print "\t<--\n" #f port) ) )
+
+(define (print-call-chain #!optional (port ##sys#standard-output) (start 0)
+				     (thread ##sys#current-thread)
+				     (header "\n\tCall history:\n") )
+  (##sys#check-output-port port #t 'print-call-chain)
+  (##sys#check-fixnum start 'print-call-chain)
+  (##sys#check-string header 'print-call-chain)
+  (let ((ct (get-call-chain start thread)))
+    (##sys#really-print-call-chain port ct header)
+    ct))
 
 (define (##sys#signal-hook mode msg . args)
   (##core#inline "C_dbg_hook" #f)
   (##core#inline "signal_debug_event" mode msg args)
   (case mode
     [(#:user-interrupt)
-     (##sys#abort
+     (abort
       (##sys#make-structure
        'condition
        '(user-interrupt)
@@ -4585,12 +4554,12 @@ EOF
      (##sys#flush-output ##sys#standard-error)]
     [else
      (when (and (symbol? msg) (null? args))
-       (set! msg (##sys#symbol->string msg)) )
+       (set! msg (symbol->string msg)) )
      (let* ([hasloc (and (or (not msg) (symbol? msg)) (pair? args))]
 	    [loc (and hasloc msg)]
 	    [msg (if hasloc (##sys#slot args 0) msg)]
 	    [args (if hasloc (##sys#slot args 1) args)] )
-       (##sys#abort
+       (abort
 	(##sys#make-structure
 	 'condition 
 	 (case mode
@@ -4611,12 +4580,12 @@ EOF
 	   [else			'(exn)] )
 	 (list '(exn . message) msg
 	       '(exn . arguments) args
-	       '(exn . call-chain) (##sys#get-call-chain)
+	       '(exn . call-chain) (get-call-chain)
 	       '(exn . location) loc) ) ) ) ] ) )
 
 (define (abort x)
   (##sys#current-exception-handler x)
-  (##sys#abort
+  (abort
    (##sys#make-structure
     'condition
     '(exn) 
@@ -4627,8 +4596,47 @@ EOF
 (define (signal x)
   (##sys#current-exception-handler x) )
 
-(define ##sys#abort abort)
-(define ##sys#signal signal)
+(define ##sys#break-on-error (foreign-value "C_enable_repl" bool))
+
+(define-foreign-variable _ex_software int "EX_SOFTWARE")
+
+(define ##sys#error-handler
+  (make-parameter
+   (let ([string-append string-append])
+     (lambda (msg . args)
+       (##sys#error-handler (lambda args (##core#inline "C_halt" "error in error")))
+       (cond ((not (foreign-value "C_gui_mode" bool))
+	      (##sys#print "\nError" #f ##sys#standard-error)
+	      (when msg
+		(##sys#print ": " #f ##sys#standard-error)
+		(##sys#print msg #f ##sys#standard-error) )
+	      (##sys#with-print-length-limit
+	       400
+	       (lambda ()
+		 (cond [(fx= 1 (length args))
+			(##sys#print ": " #f ##sys#standard-error)
+			(##sys#print (##sys#slot args 0) #t ##sys#standard-error)]
+		       [else
+			(##sys#for-each
+			 (lambda (x)
+			   (##sys#print #\newline #f ##sys#standard-error)
+			   (##sys#print x #t ##sys#standard-error))
+			 args)])))
+	      (##sys#print #\newline #f ##sys#standard-error)
+	      (print-call-chain ##sys#standard-error)
+	      (when (and ##sys#break-on-error (##sys#symbol-has-toplevel-binding? 'chicken.repl#repl))
+		;; Hack to avoid hard / cyclic dependency
+		((##sys#slot 'chicken.repl#repl 0))
+		(##sys#print #\newline #f ##sys#standard-error)
+		(##core#inline "C_exit_runtime" _ex_software) )
+	      (##core#inline "C_halt" #f) )
+	     (else
+	      (let ((out (open-output-string)))
+		(when msg (##sys#print msg #f out))
+		(##sys#print #\newline #f out)
+		(##sys#for-each (lambda (x) (##sys#print x #t out) (##sys#print #\newline #f out)) args)
+		(##core#inline "C_halt" (get-output-string out)) ) ) ) ) ) ) )
+
 
 (define ##sys#last-exception #f)	; used in csi for ,exn command
 
@@ -4670,7 +4678,7 @@ EOF
 		  "uncaught exception"
 		  (cadr (member '(uncaught-exception . reason) (##sys#slot c 2))) )
 		 ((##sys#reset-handler)) ) ) ) )
-      (##sys#abort
+      (abort
        (##sys#make-structure
 	'condition 
 	'(uncaught-exception) 
@@ -4683,6 +4691,7 @@ EOF
       thunk
       (lambda () (set! ##sys#current-exception-handler oldh)) ) ) )
 
+;; TODO: Make this a proper parameter
 (define (current-exception-handler . args)
   (if (null? args)
       ##sys#current-exception-handler
@@ -4692,6 +4701,8 @@ EOF
 	  (when set? (set! ##sys#current-exception-handler proc)))
 	proc)))
 
+;;; Condition object manipulation
+
 (define (make-property-condition kind . props)
   (##sys#make-structure
    'condition (list kind)
@@ -4828,6 +4839,15 @@ EOF
 	((55) (apply ##sys#signal-hook #:type-error loc "cannot compute absolute value of complex number" args))
 	(else (apply ##sys#signal-hook #:runtime-error loc "unknown internal error" args)) ) ) ) )
 
+) ; chicken.condition
+
+(import chicken.condition)
+
+;; OBSOLETE: This can be removed after bootstrapping, when the
+;; handle-exceptions macro won't be rewritten to a primitive alias.
+;; This is necessary because the compiler uses this macro itself.
+(define #%with-exception-handler with-exception-handler)
+
 
 ;;; Miscellaneous low-level routines:
 
diff --git a/modules.scm b/modules.scm
index 2bf32c6..034d317 100644
--- a/modules.scm
+++ b/modules.scm
@@ -1001,9 +1001,15 @@
 
 (##sys#register-core-module
  'srfi-12 'library
- '(abort condition? condition-predicate condition-property-accessor
-   current-exception-handler make-composite-condition make-property-condition
-   signal with-exception-handler)
+ '((abort . chicken.condition#abort)
+   (condition? . chicken.condition#condition?)
+   (condition-predicate . chicken.condition#condition-predicate)
+   (condition-property-accessor . chicken.condition#condition-property-accessor)
+   (current-exception-handler . chicken.condition#current-exception-handler)
+   (make-composite-condition . chicken.condition#make-composite-condition)
+   (make-property-condition . chicken.condition#make-property-condition)
+   (signal . chicken.condition#signal)
+   (with-exception-handler . chicken.condition#with-exception-handler))
  (se-subset '(handle-exceptions) ##sys#chicken-macro-environment))
 
 (##sys#register-primitive-module
diff --git a/posixunix.scm b/posixunix.scm
index 40b5b75..60f547b 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -76,6 +76,7 @@
 
 (import scheme chicken)
 (import chicken.bitwise
+	chicken.condition
 	chicken.foreign
 	chicken.irregex
 	chicken.memory
diff --git a/posixwin.scm b/posixwin.scm
index 02fc62f..4243562 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -672,6 +672,7 @@ EOF
 
 (import scheme chicken)
 (import chicken.bitwise
+	chicken.condition
 	chicken.data-structures
 	chicken.foreign
 	chicken.irregex
diff --git a/rules.make b/rules.make
index c1bdda3..56abb53 100644
--- a/rules.make
+++ b/rules.make
@@ -506,6 +506,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.time.posix,$(POSIXFI
 $(eval $(call declare-emitted-import-lib-dependency,chicken.process,$(POSIXFILE)))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.process.signal,$(POSIXFILE)))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.condition,library))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.fixnum,library))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library))
 $(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
@@ -602,6 +603,7 @@ chicken-ffi-syntax.c: chicken-ffi-syntax.scm \
 		chicken.format.import.scm
 support.c: support.scm mini-srfi-1.scm \
 		chicken.bitwise.import.scm \
+		chicken.condition.import.scm \
 		chicken.data-structures.import.scm \
 		chicken.expand.import.scm \
 		chicken.files.import.scm \
@@ -628,6 +630,7 @@ csc.c: csc.scm \
 		chicken.pathname.import.scm \
 		chicken.posix.import.scm
 csi.c: csi.scm \
+		chicken.condition.import.scm \
 		chicken.data-structures.import.scm \
 		chicken.foreign.import.scm \
 		chicken.format.import.scm \
@@ -664,6 +667,7 @@ chicken-status.c: chicken-status.scm \
 		chicken.posix.import.scm \
 		chicken.pretty-print.import.scm
 chicken-install.c: chicken-install.scm \
+		chicken.condition.import.scm \
 		chicken.data-structures.import.scm \
 		chicken.files.import.scm \
 		chicken.foreign.import.scm \
@@ -693,6 +697,7 @@ srfi-4.c: srfi-4.scm \
 		chicken.platform.import.scm
 posixunix.c: posixunix.scm \
 		chicken.bitwise.import.scm \
+		chicken.condition.import.scm \
 		chicken.foreign.import.scm \
 		chicken.irregex.import.scm \
 		chicken.memory.import.scm \
@@ -701,6 +706,7 @@ posixunix.c: posixunix.scm \
 		chicken.port.import.scm \
 		chicken.time.import.scm
 posixwin.c: posixwin.scm \
+		chicken.condition.import.scm \
 		chicken.bitwise.import.scm \
 		chicken.foreign.import.scm \
 		chicken.irregex.import.scm \
@@ -710,8 +716,10 @@ posixwin.c: posixwin.scm \
 		chicken.port.import.scm \
 		chicken.time.import.scm
 data-structures.c: data-structures.scm \
+		chicken.condition.import.scm \
 		chicken.foreign.import.scm
 expand.c: expand.scm \
+		chicken.condition.import.scm \
 		chicken.keyword.import.scm \
 		chicken.platform.import.scm \
 		chicken.internal.import.scm
@@ -719,6 +727,7 @@ extras.c: extras.scm \
 		chicken.data-structures.import.scm \
 		chicken.time.import.scm
 eval.c: eval.scm \
+		chicken.condition.import.scm \
 		chicken.expand.import.scm \
 		chicken.foreign.import.scm \
 		chicken.internal.import.scm \
@@ -760,6 +769,7 @@ bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTION
 library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib) \
 	-emit-import-library chicken.bitwise \
+	-emit-import-library chicken.condition \
 	-emit-import-library chicken.fixnum \
 	-emit-import-library chicken.flonum \
 	-emit-import-library chicken.gc \
diff --git a/scheduler.scm b/scheduler.scm
index c77c786..1cc6753 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -379,7 +379,7 @@ EOF
 	     (##sys#setslot 
 	      pt 1 
 	      (lambda ()
-		(##sys#signal arg)
+		(signal arg)
 		(ptx) ) )
 	     (##sys#thread-unblock! pt) ) )
 	  (else
diff --git a/support.scm b/support.scm
index 3d2f413..596dab9 100644
--- a/support.scm
+++ b/support.scm
@@ -77,6 +77,7 @@
 
 (import chicken scheme
 	chicken.bitwise
+	chicken.condition
 	chicken.data-structures
 	chicken.expand
 	chicken.files
diff --git a/types.db b/types.db
index 13b911b..b510c97 100644
--- a/types.db
+++ b/types.db
@@ -865,9 +865,6 @@
 
 ;; chicken
 
-(abort (procedure abort (*) noreturn))
-(##sys#abort (procedure abort (*) noreturn))
-
 (add1 (#(procedure #:clean #:enforce #:foldable) add1 (number) number)
       ((fixnum) (integer)
        (##core#inline_allocate ("C_a_i_fixnum_plus" 5) #(1) '1))
@@ -947,12 +944,28 @@
 (case-sensitive (#(procedure #:clean) case-sensitive (#!optional *) *))
 (char-name (#(procedure #:clean #:enforce) char-name ((or char symbol) #!optional char) *)) ;XXX -> (or char symbol) ?
 (command-line-arguments (#(procedure #:clean) command-line-arguments (#!optional (list-of string)) (list-of string)))
-(condition-predicate (#(procedure #:clean #:enforce) condition-predicate (symbol) (procedure ((struct condition)) boolean)))
-(condition-property-accessor (#(procedure #:clean #:enforce) condition-property-accessor (symbol symbol #!optional *) (procedure ((struct condition)) *)))
 
-(condition? (#(procedure #:pure #:predicate (struct condition)) condition? (*) boolean))
+;; condition
+
+(chicken.condition#abort (procedure chicken.condition#abort (*) noreturn))
+(chicken.condition#condition? (#(procedure #:pure #:predicate (struct condition)) chicken.condition#condition? (*) boolean))
+(chicken.condition#condition->list (#(procedure #:clean #:enforce) chicken.condition#condition->list ((struct condition)) (list-of (pair symbol *))))
+(chicken.condition#condition-predicate (#(procedure #:clean #:enforce) chicken.condition#condition-predicate (symbol) (procedure ((struct condition)) boolean)))
+(chicken.condition#condition-property-accessor (#(procedure #:clean #:enforce) chicken.condition#condition-property-accessor (symbol symbol #!optional *) (procedure ((struct condition)) *)))
 
-(condition->list (#(procedure #:clean #:enforce) condition->list ((struct condition)) (list-of (pair symbol *))))
+(chicken.condition#current-exception-handler
+ (#(procedure #:clean #:enforce) chicken.condition#current-exception-handler (#!optional (procedure (*) noreturn) boolean boolean) procedure)
+ ((procedure) (let ((#(tmp1) #(1))) 
+		(let ((#(tmp2) (set! ##sys#current-exception-handler #(tmp1))))
+		  #(tmp1))))
+ (() ##sys#current-exception-handler))
+(chicken.condition#get-call-chain (#(procedure #:clean #:enforce) chicken.condition#get-call-chain (#!optional fixnum (struct thread)) (list-of vector)))
+(chicken.condition#get-condition-property (#(procedure #:clean #:enforce) chicken.condition#get-condition-property ((struct condition) symbol symbol #!optional *) *))
+(chicken.condition#make-composite-condition (#(procedure #:clean #:enforce) chicken.condition#make-composite-condition (#!rest (struct condition)) (struct condition)))
+(chicken.condition#make-property-condition (#(procedure #:clean #:enforce) chicken.condition#make-property-condition (symbol #!rest *) (struct condition)))
+(chicken.condition#with-exception-handler
+ (#(procedure #:enforce) chicken.condition#with-exception-handler ((procedure (*) . *) (procedure () . *)) . *))
+(chicken.condition#signal (procedure chicken.condition#signal (*) . *))
 
 ;; continuation
 
@@ -987,13 +1000,6 @@
 		    #(tmp1))))
  (() ##sys#standard-error))
 
-(current-exception-handler
- (#(procedure #:clean #:enforce) current-exception-handler (#!optional (procedure (*) noreturn) boolean boolean) procedure)
- ((procedure) (let ((#(tmp1) #(1))) 
-		(let ((#(tmp2) (set! ##sys#current-exception-handler #(tmp1))))
-		  #(tmp1))))
- (() ##sys#current-exception-handler))
-
 ;; time
 
 (chicken.time#cpu-time (#(procedure #:clean) chicken.time#cpu-time () fixnum fixnum))
@@ -1191,8 +1197,6 @@
 (get (#(procedure #:clean #:enforce) get (symbol symbol #!optional *) *)
      ((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3))))
 
-(get-call-chain (#(procedure #:clean #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list-of vector)))
-(get-condition-property (#(procedure #:clean #:enforce) get-condition-property ((struct condition) symbol symbol #!optional *) *))
 (get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
 (get-output-string (#(procedure #:clean #:enforce) get-output-string (output-port) string))
 (get-properties (#(procedure #:clean #:enforce) get-properties (symbol list) symbol * list))
@@ -1252,9 +1256,7 @@
 (make-blob (#(procedure #:clean #:enforce) make-blob (fixnum) blob)
 	   ((fixnum) (##sys#make-blob #(1))))
 
-(make-composite-condition (#(procedure #:clean #:enforce) make-composite-condition (#!rest (struct condition)) (struct condition)))
 (make-parameter (#(procedure #:clean #:enforce) make-parameter (* #!optional procedure) procedure))
-(make-property-condition (#(procedure #:clean #:enforce) make-property-condition (symbol #!rest *) (struct condition)))
 (chicken.flonum#maximum-flonum float)
 (chicken.flonum#minimum-flonum float)
 (chicken.fixnum#most-negative-fixnum fixnum)
@@ -1314,7 +1316,6 @@
 		((port string) (##sys#setslot #(1) '3 #(2))))
 
 (setter (#(procedure #:clean #:enforce) setter (procedure) procedure))
-(signal (procedure signal (*) . *))
 
 (signum (#(procedure #:clean #:enforce) signum (number) (or fixnum float cplxnum))
 	((fixnum) (fixnum) (##core#inline "C_i_fixnum_signum" #(1)))
@@ -1356,9 +1357,6 @@
 (##sys#void (#(procedure #:pure) void (#!rest) undefined))
 (warning (procedure warning (* #!rest) undefined))
 
-(with-exception-handler
- (#(procedure #:enforce) with-exception-handler ((procedure (*) . *) (procedure () . *)) . *))
-
 ;; chicken (internal)
 
 (##sys#foreign-char-argument (#(procedure #:clean #:enforce) ##sys#foreign-char-argument (char) char)
-- 
2.1.4