From 8a2fdff30184a00907bcf6aaf27338fbebda2020 Mon Sep 17 00:00:00 2001 From: Peter Bex 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