~ chicken-core (chicken-5) aa2d6b8247b13476fe609d1fd263238cc10a6a8e

commit aa2d6b8247b13476fe609d1fd263238cc10a6a8e
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Sep 23 08:34:20 2011 +0200
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Fri Sep 23 11:24:28 2011 +0200

        pseudo parameters current-input-port, current-output-port, current-error-port and current-exception-handler now return the correct value in the assignment case; fixed some types.db entries; all noted by sjamaan
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/library.scm b/library.scm
index 8ceb7de1..d84c8053 100644
--- a/library.scm
+++ b/library.scm
@@ -1813,25 +1813,25 @@ EOF
   p )
 
 (define (current-input-port . arg)
-  (if (pair? arg)
-      (let ([p (car arg)])
-	(##sys#check-port p 'current-input-port)
-	(set! ##sys#standard-input p) )
-      ##sys#standard-input) )
+  (when (pair? arg)
+    (let ([p (car arg)])
+      (##sys#check-port p 'current-input-port)
+      (set! ##sys#standard-input p) ))
+  ##sys#standard-input)
 
 (define (current-output-port . arg)
-  (if (pair? arg)
-      (let ([p (car arg)])
-	(##sys#check-port p 'current-output-port)
-	(set! ##sys#standard-output p) )
-      ##sys#standard-output) )
+  (when (pair? arg)
+    (let ([p (car arg)])
+      (##sys#check-port p 'current-output-port)
+      (set! ##sys#standard-output p) ) )
+  ##sys#standard-output)
 
 (define (current-error-port . arg)
-  (if (pair? arg)
-      (let ([p (car arg)])
-	(##sys#check-port p 'current-error-port)
-	(set! ##sys#standard-error p) )
-      ##sys#standard-error) )
+  (when (pair? arg)
+    (let ([p (car arg)])
+      (##sys#check-port p 'current-error-port)
+      (set! ##sys#standard-error p) ) )
+  ##sys#standard-error)
 
 (define (##sys#tty-port? port)
   (and (not (zero? (##sys#peek-unsigned-integer port 0)))
@@ -3954,9 +3954,9 @@ EOF
       (lambda () (set! ##sys#current-exception-handler oldh)) ) ) )
 
 (define (current-exception-handler #!optional proc)
-  (if proc
-      (set! ##sys#current-exception-handler proc)
-      ##sys#current-exception-handler))
+  (when proc
+    (set! ##sys#current-exception-handler proc))
+  ##sys#current-exception-handler)
 
 (define (make-property-condition kind . props)
   (##sys#make-structure
diff --git a/types.db b/types.db
index de03b3c4..17f1f01c 100644
--- a/types.db
+++ b/types.db
@@ -684,6 +684,7 @@
 ;; chicken
 
 (abort (procedure abort (*) noreturn))
+(##sys#abort (procedure abort (*) noreturn))
 
 (add1 (#(procedure #:clean #:enforce) add1 (number) number)
       ((float) (float) 
@@ -1069,7 +1070,7 @@
 			       ((string) #(1)))
 (##sys#foreign-symbol-argument (#(procedure #:clean #:enforce) ##sys#foreign-symbol-argument (symbol) symbol)
 			       ((symbol) #(1)))
-(##sys#foreign-pointer-argument (#(procedure #:clean #:enforce) ##sys#foreign-pointer-argument ((or boolean pointer)) pointer)
+(##sys#foreign-pointer-argument (#(procedure #:clean #:enforce) ##sys#foreign-pointer-argument (pointer) pointer)
 				((pointer) #(1)))
 
 (##sys#check-blob (#(procedure #:clean #:enforce) ##sys#check-blob (blob #!optional *) *)