Hi all, Attached are two simple patches to make the (chicken port) module conform a bit better to core-libraries-reorganization.
Cheers, Peter
From 8a2fdff30184a00907bcf6aaf27338fbebda2020 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Tue, 18 Jul 2017 21:46:38 +0200
Subject: [PATCH 1/2] Move set-buffering-mode! from posix{unix,win}.scm to
port.scm
There was no real reason for having the two implementations separated
in Windows- and UNIX-specific POSIX files, so this just moves the
definition. To avoid another ugly #define block, the ##core#inline
is replaced with a simpler foreign-lambda*.
---
port.scm | 27 ++++++++++++++++++++++++++-
posix.scm | 4 ++--
posixunix.scm | 22 ----------------------
posixwin.scm | 22 ----------------------
types.db | 2 +-
5 files changed, 29 insertions(+), 48 deletions(-)
diff --git a/port.scm b/port.scm
index 3964ed5a..c61a046b 100644
--- a/port.scm
+++ b/port.scm
@@ -48,6 +48,7 @@
make-bidirectional-port
make-broadcast-port
make-concatenated-port
+ set-buffering-mode!
with-error-to-port
with-input-from-port
with-input-from-string
@@ -56,10 +57,34 @@
with-error-to-string)
(import scheme chicken)
-(import chicken.io)
+(import chicken.foreign
+ chicken.io)
(include "common-declarations.scm")
+(define-foreign-variable _iofbf int "_IOFBF")
+(define-foreign-variable _iolbf int "_IOLBF")
+(define-foreign-variable _ionbf int "_IONBF")
+(define-foreign-variable _bufsiz int "BUFSIZ")
+
+(define set-buffering-mode!
+ (lambda (port mode . size)
+ (##sys#check-port port 'set-buffering-mode!)
+ (let ((size (if (pair? size) (car size) _bufsiz))
+ (mode (case mode
+ ((#:full) _iofbf)
+ ((#:line) _iolbf)
+ ((#:none) _ionbf)
+ (else (##sys#error 'set-buffering-mode! "invalid buffering-mode" mode port)) ) ) )
+ (##sys#check-fixnum size 'set-buffering-mode!)
+ (when (fx< (if (eq? 'stream (##sys#slot port 7))
+ ((foreign-lambda* int
+ ((scheme-object p) (int m) (int s))
+ "C_return(setvbuf(C_port_file(p), NULL, m, s));")
+ port mode size)
+ -1)
+ 0)
+ (##sys#error 'set-buffering-mode! "cannot set buffering mode" port mode size) ) ) ) )
;;;; Port-mapping (found in Gauche):
diff --git a/posix.scm b/posix.scm
index d4815ff7..44cf77b0 100644
--- a/posix.scm
+++ b/posix.scm
@@ -68,8 +68,8 @@
process-group-id process-run process-signal process-sleep
process-spawn process-wait read-symbolic-link regular-file?
seconds->local-time seconds->string seconds->utc-time seek/cur
- seek/end seek/set set-alarm! set-buffering-mode!
- set-environment-variable! set-file-group! set-file-owner!
+ seek/end seek/set
+ set-alarm! set-environment-variable! set-file-group! set-file-owner!
set-file-permissions! set-file-position! set-file-times!
set-root-directory! set-signal-handler! set-signal-mask!
signal-handler signal-mask signal-mask! signal-masked? signal-unmask!
diff --git a/posixunix.scm b/posixunix.scm
index 63f0f891..9203c03a 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -150,7 +150,6 @@ static C_TLS struct stat C_statbuf;
#define C_ftruncate(f, n) C_fix(ftruncate(C_unfix(f), C_num_to_int(n)))
#define C_uname C_fix(uname(&C_utsname))
#define C_alarm alarm
-#define C_setvbuf(p, m, s) C_fix(setvbuf(C_port_file(p), NULL, C_unfix(m), C_unfix(s)))
#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
#define C_close(fd) C_fix(close(C_unfix(fd)))
#define C_umask(m) C_fix(umask(C_unfix(m)))
@@ -1286,27 +1285,6 @@ static C_word C_i_fifo_p(C_word name)
(define set-alarm! (foreign-lambda int "C_alarm" int))
-(define-foreign-variable _iofbf int "_IOFBF")
-(define-foreign-variable _iolbf int "_IOLBF")
-(define-foreign-variable _ionbf int "_IONBF")
-(define-foreign-variable _bufsiz int "BUFSIZ")
-
-(define set-buffering-mode!
- (lambda (port mode . size)
- (##sys#check-port port 'set-buffering-mode!)
- (let ([size (if (pair? size) (car size) _bufsiz)]
- [mode (case mode
- [(#:full) _iofbf]
- [(#:line) _iolbf]
- [(#:none) _ionbf]
- [else (##sys#error 'set-buffering-mode! "invalid buffering-mode" mode port)] ) ] )
- (##sys#check-fixnum size 'set-buffering-mode!)
- (when (fx< (if (eq? 'stream (##sys#slot port 7))
- (##core#inline "C_setvbuf" port mode size)
- -1)
- 0)
- (##sys#error 'set-buffering-mode! "cannot set buffering mode" port mode size) ) ) ) )
-
(define (terminal-port? port)
(##sys#check-open-port port 'terminal-port?)
(let ([fp (##sys#peek-unsigned-integer port 0)])
diff --git a/posixwin.scm b/posixwin.scm
index b6c6ff0b..2e0819ac 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -202,7 +202,6 @@ readdir(DIR * dir)
#define close_pipe(p) C_fix(_pclose(C_port_file(p)))
#define C_chmod(fn, m) C_fix(chmod(C_data_pointer(fn), C_unfix(m)))
-#define C_setvbuf(p, m, s) C_fix(setvbuf(C_port_file(p), NULL, C_unfix(m), C_unfix(s)))
#define C_test_access(fn, m) C_fix(access((char *)C_data_pointer(fn), C_unfix(m)))
#define C_pipe(d, m) C_fix(_pipe(C_pipefds, PIPE_BUF, C_unfix(m)))
#define C_close(fd) C_fix(close(C_unfix(fd)))
@@ -1053,27 +1052,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(values 0 0)
(##sys#error 'terminal-size "port is not connected to a terminal" port)))
-(define-foreign-variable _iofbf int "_IOFBF")
-(define-foreign-variable _iolbf int "_IOLBF")
-(define-foreign-variable _ionbf int "_IONBF")
-(define-foreign-variable _bufsiz int "BUFSIZ")
-
-(define set-buffering-mode!
- (lambda (port mode . size)
- (##sys#check-open-port port 'set-buffering-mode!)
- (let ([size (if (pair? size) (car size) _bufsiz)]
- [mode (case mode
- [(###full) _iofbf]
- [(###line) _iolbf]
- [(###none) _ionbf]
- [else (##sys#error 'set-buffering-mode! "invalid buffering-mode" mode port)] ) ] )
- (##sys#check-fixnum size 'set-buffering-mode!)
- (when (fx< (if (eq? 'stream (##sys#slot port 7))
- (##core#inline "C_setvbuf" port mode size)
- -1)
- 0)
- (##sys#error 'set-buffering-mode! "cannot set buffering mode" port mode size) ) ) ) )
-
;;; Process handling:
(define-foreign-variable _p_overlay int "P_OVERLAY")
diff --git a/types.db b/types.db
index 98d10e08..9f6d4015 100644
--- a/types.db
+++ b/types.db
@@ -1863,6 +1863,7 @@
(chicken.port#make-bidirectional-port (#(procedure #:clean #:enforce) chicken.port#make-bidirectional-port (input-port output-port) (refine (input output) port)))
(chicken.port#make-broadcast-port (#(procedure #:clean #:enforce) chicken.port#make-broadcast-port (#!rest output-port) output-port))
(chicken.port#make-concatenated-port (#(procedure #:clean #:enforce) chicken.port#make-concatenated-port (port #!rest input-port) input-port))
+(chicken.port#set-buffering-mode! (#(procedure #:clean #:enforce) chicken.port#set-buffering-mode! (port symbol #!optional fixnum) undefined))
(chicken.port#with-error-to-port (#(procedure #:enforce) chicken.port#with-error-to-port (output-port (procedure () . *)) . *))
(chicken.port#with-input-from-port (#(procedure #:enforce) chicken.port#with-input-from-port (input-port (procedure () . *)) . *))
(chicken.port#with-input-from-string (#(procedure #:enforce) chicken.port#with-input-from-string (string (procedure () . *)) . *))
@@ -2040,7 +2041,6 @@
(chicken.posix#seek/end fixnum)
(chicken.posix#seek/set fixnum)
(chicken.posix#set-alarm! (#(procedure #:clean #:enforce) chicken.posix#set-alarm! (integer) integer))
-(chicken.posix#set-buffering-mode! (#(procedure #:clean #:enforce) chicken.posix#set-buffering-mode! (port symbol #!optional fixnum) undefined))
(chicken.posix#set-file-group! (#(procedure #:clean #:enforce) chicken.posix#set-file-group! ((or string fixnum port) fixnum) undefined))
(chicken.posix#set-file-owner! (#(procedure #:clean #:enforce) chicken.posix#set-file-owner! ((or string fixnum port) fixnum) undefined))
(chicken.posix#set-file-permissions! (#(procedure #:clean #:enforce) chicken.posix#set-file-permissions! ((or string fixnum port) fixnum) undefined))
--
2.11.0
From a448d7d53f2f73c78d004667a90bf4bbd5d96aa8 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Tue, 18 Jul 2017 21:50:04 +0200
Subject: [PATCH 2/2] Rename with-error-to-* to with-error-output-to-*
---
port.scm | 10 +++++-----
types.db | 4 ++--
2 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/port.scm b/port.scm
index c61a046b..5d58e64a 100644
--- a/port.scm
+++ b/port.scm
@@ -49,12 +49,12 @@
make-broadcast-port
make-concatenated-port
set-buffering-mode!
- with-error-to-port
+ with-error-output-to-port
with-input-from-port
with-input-from-string
with-output-to-port
with-output-to-string
- with-error-to-string)
+ with-error-output-to-string)
(import scheme chicken)
(import chicken.foreign
@@ -218,8 +218,8 @@
(fluid-let ((##sys#standard-output port))
(thunk) ) )
-(define (with-error-to-port port thunk)
- (##sys#check-output-port port #t 'with-error-to-port)
+(define (with-error-output-to-port port thunk)
+ (##sys#check-output-port port #t 'with-error-output-to-port)
(fluid-let ((##sys#standard-error port))
(thunk) ) )
@@ -247,7 +247,7 @@
(thunk)
(get-output-string ##sys#standard-output) ) ) )
-(define with-error-to-string
+(define with-error-output-to-string
(lambda (thunk)
(fluid-let ((##sys#standard-error (open-output-string)))
(thunk)
diff --git a/types.db b/types.db
index 9f6d4015..2b2fb1cc 100644
--- a/types.db
+++ b/types.db
@@ -1864,12 +1864,12 @@
(chicken.port#make-broadcast-port (#(procedure #:clean #:enforce) chicken.port#make-broadcast-port (#!rest output-port) output-port))
(chicken.port#make-concatenated-port (#(procedure #:clean #:enforce) chicken.port#make-concatenated-port (port #!rest input-port) input-port))
(chicken.port#set-buffering-mode! (#(procedure #:clean #:enforce) chicken.port#set-buffering-mode! (port symbol #!optional fixnum) undefined))
-(chicken.port#with-error-to-port (#(procedure #:enforce) chicken.port#with-error-to-port (output-port (procedure () . *)) . *))
+(chicken.port#with-error-output-to-port (#(procedure #:enforce) chicken.port#with-error-output-to-port (output-port (procedure () . *)) . *))
(chicken.port#with-input-from-port (#(procedure #:enforce) chicken.port#with-input-from-port (input-port (procedure () . *)) . *))
(chicken.port#with-input-from-string (#(procedure #:enforce) chicken.port#with-input-from-string (string (procedure () . *)) . *))
(chicken.port#with-output-to-port (#(procedure #:enforce) chicken.port#with-output-to-port (output-port (procedure () . *)) . *))
(chicken.port#with-output-to-string (#(procedure #:enforce) chicken.port#with-output-to-string ((procedure () . *)) string))
-(chicken.port#with-error-to-string (#(procedure #:enforce) chicken.port#with-error-to-string ((procedure () . *)) string))
+(chicken.port#with-error-output-to-string (#(procedure #:enforce) chicken.port#with-error-output-to-string ((procedure () . *)) string))
;; errno
--
2.11.0
signature.asc
Description: PGP signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
