~ chicken-core (chicken-5) de6281c1aa45380184397122a6bfb03f5b0558c2
commit de6281c1aa45380184397122a6bfb03f5b0558c2
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Mon Apr 30 14:38:14 2018 +0200
Commit: Kooda <kooda@upyum.com>
CommitDate: Tue May 1 10:33:53 2018 +0200
Refactor chicken.file.posix so it no longer refers to chicken.posix
This ensures when a user enters something like "open-input-file*" on
the REPL, they will see "chicken.file.posix#open-input-file*" instead
of "chicken.posix#open-input-file*" which is an internal
implementation detail even moreso than the #-prefixed module name in
the identifier.
Some other small changes:
- Removed duplicate definitions of fifo?, port->fileno and
open-{input,output}-file* from posixwin (already in posix-common)
- Moved shared open/ and perm/ definitions to posix-common
- Moved shared fileno/{stdin,stdout,stderr} to posix-common
- Fixed a small bug: check call in duplicate-fileno did not quote
the procedure name for "loc" argument.
Signed-off-by: Kooda <kooda@upyum.com>
diff --git a/posix-common.scm b/posix-common.scm
index 2b3ab43d..29ab9687 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -98,9 +98,16 @@ EOF
(define-syntax define-unimplemented
(syntax-rules ()
- [(_ ?name)
+ ((_ ?name)
(define (?name . _)
- (error '?name (##core#immutable '"this function is not available on this platform")) ) ] ) )
+ (error '?name (##core#immutable '"this function is not available on this platform")) ) ) ) )
+
+(define-syntax set!-unimplemented
+ (syntax-rules ()
+ ((_ ?name)
+ (set! ?name
+ (lambda _
+ (error '?name (##core#immutable '"this function is not available on this platform"))) ) ) ) )
;;; Error codes:
@@ -195,7 +202,7 @@ EOF
(define (stat file link err loc)
(let ((r (cond ((fixnum? file) (##core#inline "C_u_i_fstat" file))
- ((port? file) (##core#inline "C_u_i_fstat" (port->fileno file)))
+ ((port? file) (##core#inline "C_u_i_fstat" (chicken.file.posix#port->fileno file)))
((string? file)
(let ((path (##sys#make-c-string file loc)))
(if link
@@ -210,102 +217,125 @@ EOF
#f)
#t)))
-(define (file-stat f #!optional link)
- (stat f link #t 'file-stat)
- (vector _stat_st_ino _stat_st_mode _stat_st_nlink
- _stat_st_uid _stat_st_gid _stat_st_size
- _stat_st_atime _stat_st_ctime _stat_st_mtime
- _stat_st_dev _stat_st_rdev
- _stat_st_blksize _stat_st_blocks) )
-
-(define (set-file-permissions! f p)
- (##sys#check-fixnum p 'set-file-permissions!)
- (let ((r (cond ((fixnum? f) (##core#inline "C_fchmod" f p))
- ((port? f) (##core#inline "C_fchmod" (port->fileno f) p))
- ((string? f)
- (##core#inline "C_chmod"
- (##sys#make-c-string f 'set-file-permissions!) p))
- (else
- (##sys#signal-hook
- #:type-error 'file-permissions
- "bad argument type - not a fixnum, port or string" f)) ) ) )
- (when (fx< r 0)
- (posix-error #:file-error 'set-file-permissions! "cannot change file permissions" f p) ) ))
-
-(define (file-modification-time f) (stat f #f #t 'file-modification-time) _stat_st_mtime)
-(define (file-access-time f) (stat f #f #t 'file-access-time) _stat_st_atime)
-(define (file-change-time f) (stat f #f #t 'file-change-time) _stat_st_ctime)
-
-(define (set-file-times! f . rest)
- (let-optionals* rest ((atime (current-seconds)) (mtime atime))
- (when atime (##sys#check-exact-integer atime 'set-file-times!))
- (when mtime (##sys#check-exact-integer mtime 'set-file-times!))
- (let ((r ((foreign-lambda int "set_file_mtime"
- c-string scheme-object scheme-object)
- f atime mtime)))
+(set! chicken.file.posix#file-stat
+ (lambda (f #!optional link)
+ (stat f link #t 'file-stat)
+ (vector _stat_st_ino _stat_st_mode _stat_st_nlink
+ _stat_st_uid _stat_st_gid _stat_st_size
+ _stat_st_atime _stat_st_ctime _stat_st_mtime
+ _stat_st_dev _stat_st_rdev
+ _stat_st_blksize _stat_st_blocks) ) )
+
+(set! chicken.file.posix#set-file-permissions!
+ (lambda (f p)
+ (##sys#check-fixnum p 'set-file-permissions!)
+ (let ((r (cond ((fixnum? f) (##core#inline "C_fchmod" f p))
+ ((port? f) (##core#inline "C_fchmod" (chicken.file.posix#port->fileno f) p))
+ ((string? f)
+ (##core#inline "C_chmod"
+ (##sys#make-c-string f 'set-file-permissions!) p))
+ (else
+ (##sys#signal-hook
+ #:type-error 'file-permissions
+ "bad argument type - not a fixnum, port or string" f)) ) ) )
(when (fx< r 0)
- (apply posix-error
- #:file-error
- 'set-file-times! "cannot set file times" f rest)))))
-
-(define (file-size f) (stat f #f #t 'file-size) _stat_st_size)
-
-(define (set-file-owner! f uid)
- (chown 'set-file-owner! f uid -1))
-
-(define (set-file-group! f gid)
- (chown 'set-file-group! f -1 gid))
-
-(define file-owner
+ (posix-error #:file-error 'set-file-permissions! "cannot change file permissions" f p) ) )))
+
+(set! chicken.file.posix#file-modification-time
+ (lambda (f)
+ (stat f #f #t 'file-modification-time)
+ _stat_st_mtime))
+(set! chicken.file.posix#file-access-time
+ (lambda (f)
+ (stat f #f #t 'file-access-time)
+ _stat_st_atime))
+(set! chicken.file.posix#file-change-time
+ (lambda (f)
+ (stat f #f #t 'file-change-time)
+ _stat_st_ctime))
+
+(set! chicken.file.posix#set-file-times!
+ (lambda (f . rest)
+ (let-optionals* rest ((atime (current-seconds)) (mtime atime))
+ (when atime (##sys#check-exact-integer atime 'set-file-times!))
+ (when mtime (##sys#check-exact-integer mtime 'set-file-times!))
+ (let ((r ((foreign-lambda int "set_file_mtime"
+ c-string scheme-object scheme-object)
+ f atime mtime)))
+ (when (fx< r 0)
+ (apply posix-error
+ #:file-error
+ 'set-file-times! "cannot set file times" f rest))))))
+
+(set! chicken.file.posix#file-size
+ (lambda (f) (stat f #f #t 'file-size) _stat_st_size))
+
+(set! chicken.file.posix#set-file-owner!
+ (lambda (f uid)
+ (chown 'set-file-owner! f uid -1)))
+
+(set! chicken.file.posix#set-file-group!
+ (lambda (f gid)
+ (chown 'set-file-group! f -1 gid)))
+
+(set! chicken.file.posix#file-owner
(getter-with-setter
(lambda (f) (stat f #f #t 'file-owner) _stat_st_uid)
- set-file-owner!) )
+ chicken.file.posix#set-file-owner!) )
-(define file-group
+(set! chicken.file.posix#file-group
(getter-with-setter
(lambda (f) (stat f #f #t 'file-group) _stat_st_gid)
- set-file-group!) )
+ chicken.file.posix#set-file-group!) )
-(define file-permissions
+(set! chicken.file.posix#file-permissions
(getter-with-setter
(lambda (f)
(stat f #f #t 'file-permissions)
(foreign-value "C_stat_perm" unsigned-int))
- set-file-permissions! ))
-
-(define (file-type file #!optional link (err #t))
- (and (stat file link err 'file-type)
- (let ((res (foreign-value "C_stat_type" unsigned-int)))
- (cond
- ((fx= res S_IFREG) 'regular-file)
- ((fx= res S_IFLNK) 'symbolic-link)
- ((fx= res S_IFDIR) 'directory)
- ((fx= res S_IFCHR) 'character-device)
- ((fx= res S_IFBLK) 'block-device)
- ((fx= res S_IFIFO) 'fifo)
- ((fx= res S_IFSOCK) 'socket)
- (else 'regular-file)))))
-
-(define (regular-file? file)
- (eq? 'regular-file (file-type file #f #f)))
-
-(define (symbolic-link? file)
- (eq? 'symbolic-link (file-type file #t #f)))
-
-(define (block-device? file)
- (eq? 'block-device (file-type file #f #f)))
-
-(define (character-device? file)
- (eq? 'character-device (file-type file #f #f)))
-
-(define (fifo? file)
- (eq? 'fifo (file-type file #f #f)))
-
-(define (socket? file)
- (eq? 'socket (file-type file #f #f)))
-
-(define (directory? file)
- (eq? 'directory (file-type file #f #f)))
+ chicken.file.posix#set-file-permissions! ))
+
+(set! chicken.file.posix#file-type
+ (lambda (file #!optional link (err #t))
+ (and (stat file link err 'file-type)
+ (let ((res (foreign-value "C_stat_type" unsigned-int)))
+ (cond
+ ((fx= res S_IFREG) 'regular-file)
+ ((fx= res S_IFLNK) 'symbolic-link)
+ ((fx= res S_IFDIR) 'directory)
+ ((fx= res S_IFCHR) 'character-device)
+ ((fx= res S_IFBLK) 'block-device)
+ ((fx= res S_IFIFO) 'fifo)
+ ((fx= res S_IFSOCK) 'socket)
+ (else 'regular-file))))))
+
+(set! chicken.file.posix#regular-file?
+ (lambda (file)
+ (eq? 'regular-file (chicken.file.posix#file-type file #f #f))))
+
+(set! chicken.file.posix#symbolic-link?
+ (lambda (file)
+ (eq? 'symbolic-link (chicken.file.posix#file-type file #t #f))))
+
+(set! chicken.file.posix#block-device?
+ (lambda (file)
+ (eq? 'block-device (chicken.file.posix#file-type file #f #f))))
+
+(set! chicken.file.posix#character-device?
+ (lambda (file)
+ (eq? 'character-device (chicken.file.posix#file-type file #f #f))))
+
+(set! chicken.file.posix#fifo?
+ (lambda (file)
+ (eq? 'fifo (chicken.file.posix#file-type file #f #f))))
+
+(set! chicken.file.posix#socket?
+ (lambda (file)
+ (eq? 'socket (chicken.file.posix#file-type file #f #f))))
+
+(set! chicken.file.posix#directory?
+ (lambda (file)
+ (eq? 'directory (chicken.file.posix#file-type file #f #f))))
;;; File position access:
@@ -314,11 +344,11 @@ EOF
(define-foreign-variable _seek_cur int "SEEK_CUR")
(define-foreign-variable _seek_end int "SEEK_END")
-(define seek/set _seek_set)
-(define seek/end _seek_end)
-(define seek/cur _seek_cur)
+(set! chicken.file.posix#seek/set _seek_set)
+(set! chicken.file.posix#seek/end _seek_end)
+(set! chicken.file.posix#seek/cur _seek_cur)
-(define set-file-position!
+(set! chicken.file.posix#set-file-position!
(lambda (port pos . whence)
(let ((whence (if (pair? whence) (car whence) _seek_set)))
(##sys#check-fixnum pos 'set-file-position!)
@@ -332,7 +362,7 @@ EOF
(##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)) )
(posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) )
-(define file-position
+(set! chicken.file.posix#file-position
(getter-with-setter
(lambda (port)
(let ((pos (cond ((port? port)
@@ -346,7 +376,7 @@ EOF
(when (< pos 0)
(posix-error #:file-error 'file-position "cannot retrieve file position of port" port) )
pos) )
- set-file-position! ; doesn't accept WHENCE
+ chicken.file.posix#set-file-position! ; doesn't accept WHENCE
"(file-position port)"))
@@ -356,12 +386,61 @@ EOF
(define-foreign-variable _stdout_fileno int "STDOUT_FILENO")
(define-foreign-variable _stderr_fileno int "STDERR_FILENO")
-(define fileno/stdin _stdin_fileno)
-(define fileno/stdout _stdout_fileno)
-(define fileno/stderr _stderr_fileno)
-
-(define open-input-file*)
-(define open-output-file*)
+(set! chicken.file.posix#fileno/stdin _stdin_fileno)
+(set! chicken.file.posix#fileno/stdout _stdout_fileno)
+(set! chicken.file.posix#fileno/stderr _stderr_fileno)
+
+(define-foreign-variable _o_rdonly int "O_RDONLY")
+(define-foreign-variable _o_wronly int "O_WRONLY")
+(define-foreign-variable _o_rdwr int "O_RDWR")
+(define-foreign-variable _o_creat int "O_CREAT")
+(define-foreign-variable _o_append int "O_APPEND")
+(define-foreign-variable _o_excl int "O_EXCL")
+(define-foreign-variable _o_trunc int "O_TRUNC")
+(define-foreign-variable _o_binary int "O_BINARY")
+(define-foreign-variable _o_text int "O_TEXT")
+
+(set! chicken.file.posix#open/rdonly _o_rdonly)
+(set! chicken.file.posix#open/wronly _o_wronly)
+(set! chicken.file.posix#open/rdwr _o_rdwr)
+(set! chicken.file.posix#open/read _o_rdonly)
+(set! chicken.file.posix#open/write _o_wronly)
+(set! chicken.file.posix#open/creat _o_creat)
+(set! chicken.file.posix#open/append _o_append)
+(set! chicken.file.posix#open/excl _o_excl)
+(set! chicken.file.posix#open/trunc _o_trunc)
+(set! chicken.file.posix#open/binary _o_binary)
+(set! chicken.file.posix#open/text _o_text)
+
+;; open/noinherit is platform-specific
+
+(define-foreign-variable _s_irusr int "S_IREAD")
+(define-foreign-variable _s_iwusr int "S_IWRITE")
+(define-foreign-variable _s_ixusr int "S_IEXEC")
+(define-foreign-variable _s_irgrp int "S_IREAD")
+(define-foreign-variable _s_iwgrp int "S_IWRITE")
+(define-foreign-variable _s_ixgrp int "S_IEXEC")
+(define-foreign-variable _s_iroth int "S_IREAD")
+(define-foreign-variable _s_iwoth int "S_IWRITE")
+(define-foreign-variable _s_ixoth int "S_IEXEC")
+(define-foreign-variable _s_irwxu int "S_IREAD | S_IWRITE | S_IEXEC")
+(define-foreign-variable _s_irwxg int "S_IREAD | S_IWRITE | S_IEXEC")
+(define-foreign-variable _s_irwxo int "S_IREAD | S_IWRITE | S_IEXEC")
+
+(set! chicken.file.posix#perm/irusr _s_irusr)
+(set! chicken.file.posix#perm/iwusr _s_iwusr)
+(set! chicken.file.posix#perm/ixusr _s_ixusr)
+(set! chicken.file.posix#perm/irgrp _s_irgrp)
+(set! chicken.file.posix#perm/iwgrp _s_iwgrp)
+(set! chicken.file.posix#perm/ixgrp _s_ixgrp)
+(set! chicken.file.posix#perm/iroth _s_iroth)
+(set! chicken.file.posix#perm/iwoth _s_iwoth)
+(set! chicken.file.posix#perm/ixoth _s_ixoth)
+(set! chicken.file.posix#perm/irwxu _s_irwxu)
+(set! chicken.file.posix#perm/irwxg _s_irwxg)
+(set! chicken.file.posix#perm/irwxo _s_irwxo)
+
+;; perm/isvtx, perm/isuid and perm/isgid are platform-specific
(let ()
(define (mode inp m loc)
@@ -380,34 +459,34 @@ EOF
(let ((port (##sys#make-port (if inp 1 2) ##sys#stream-port-class "(fdport)" 'stream)))
(##core#inline "C_set_file_ptr" port r)
port) ) )
- (set! open-input-file*
+ (set! chicken.file.posix#open-input-file*
(lambda (fd . m)
(##sys#check-fixnum fd 'open-input-file*)
(check 'open-input-file* fd #t (##core#inline_allocate ("C_fdopen" 2) fd (mode #t m 'open-input-file*))) ) )
- (set! open-output-file*
+ (set! chicken.file.posix#open-output-file*
(lambda (fd . m)
(##sys#check-fixnum fd 'open-output-file*)
(check 'open-output-file* fd #f (##core#inline_allocate ("C_fdopen" 2) fd (mode #f m 'open-output-file*)) ) ) ) )
-(define port->fileno
+(set! chicken.file.posix#port->fileno
(lambda (port)
(##sys#check-open-port port 'port->fileno)
- (cond [(eq? 'socket (##sys#slot port 7))
+ (cond ((eq? 'socket (##sys#slot port 7))
;; Extract socket-FD from the port's "data" object - this is identical
;; to "##sys#tcp-port->fileno" in the tcp unit (tcp.scm). We code it in
;; this low-level manner to avoid depend on code defined there.
;; Peter agrees with that. I think. Have a nice day.
- (##sys#slot (##sys#port-data port) 0) ]
- [(not (zero? (##sys#peek-unsigned-integer port 0)))
+ (##sys#slot (##sys#port-data port) 0) )
+ ((not (zero? (##sys#peek-unsigned-integer port 0)))
(let ([fd (##core#inline "C_port_fileno" port)])
(when (fx< fd 0)
(posix-error #:file-error 'port->fileno "cannot access file-descriptor of port" port) )
- fd) ]
- [else (posix-error #:type-error 'port->fileno "port has no attached file" port)] ) ) )
+ fd) )
+ (else (posix-error #:type-error 'port->fileno "port has no attached file" port)) ) ) )
-(define duplicate-fileno
+(set! chicken.file.posix#duplicate-fileno
(lambda (old . new)
- (##sys#check-fixnum old duplicate-fileno)
+ (##sys#check-fixnum old 'duplicate-fileno)
(let ([fd (if (null? new)
(##core#inline "C_dup" old)
(let ([n (car new)])
@@ -433,7 +512,7 @@ EOF
;;; umask
-(define file-creation-mode
+(set! chicken.file.posix#file-creation-mode
(getter-with-setter
(lambda (#!optional um)
(when um (##sys#check-fixnum um 'file-creation-mode))
diff --git a/posix.scm b/posix.scm
index 24c7e76c..bdd8c5d2 100644
--- a/posix.scm
+++ b/posix.scm
@@ -39,41 +39,145 @@
(disable-interrupts)
(not inline ##sys#interrupt-hook ##sys#user-interrupt-hook))
-;; This module really does not belong, but it is used to keep all the
-;; posix stuff in one place. The modules defined later are actually
-;; the user-visible ones.
+
+(module chicken.file.posix
+ (create-fifo create-symbolic-link read-symbolic-link
+ duplicate-fileno fcntl/dupfd fcntl/getfd fcntl/getfl fcntl/setfd
+ fcntl/setfl file-access-time file-change-time file-modification-time
+ file-close file-control file-creation-mode file-group file-link
+ file-lock file-lock/blocking file-mkstemp file-open file-owner
+ file-permissions file-position file-read file-select file-size
+ file-stat file-test-lock file-truncate file-unlock file-write
+ file-type block-device? character-device? directory? fifo?
+ regular-file? socket? symbolic-link?
+ fileno/stderr fileno/stdin fileno/stdout
+ open-input-file* open-output-file*
+ open/append open/binary open/creat open/excl open/fsync open/noctty
+ open/noinherit open/nonblock open/rdonly open/rdwr open/read
+ open/sync open/text open/trunc open/write open/wronly
+ perm/irgrp perm/iroth perm/irusr perm/irwxg perm/irwxo perm/irwxu
+ perm/isgid perm/isuid perm/isvtx perm/iwgrp perm/iwoth perm/iwusr
+ perm/ixgrp perm/ixoth perm/ixusr
+ port->fileno set-file-group! set-file-owner!
+ set-file-permissions! set-file-position! set-file-times!
+ seek/cur seek/set seek/end)
+
+(import scheme)
+
+(define create-fifo)
+(define create-symbolic-link)
+(define read-symbolic-link)
+(define duplicate-fileno)
+
+(define fcntl/dupfd)
+(define fcntl/getfd)
+(define fcntl/getfl)
+(define fcntl/setfd)
+(define fcntl/setfl)
+
+(define file-access-time)
+(define file-change-time)
+(define file-modification-time)
+(define file-close)
+(define file-control)
+(define file-creation-mode)
+(define file-group)
+(define file-link)
+(define file-lock)
+(define file-lock/blocking)
+(define file-mkstemp)
+(define file-open)
+(define file-owner)
+(define file-permissions)
+(define file-position)
+(define file-read)
+(define file-select)
+(define file-size)
+(define file-stat)
+(define file-test-lock)
+(define file-truncate)
+(define file-unlock)
+(define file-write)
+(define file-type)
+
+(define block-device?)
+(define character-device?)
+(define directory?)
+(define fifo?)
+(define regular-file?)
+(define socket?)
+(define symbolic-link?)
+
+(define fileno/stderr)
+(define fileno/stdin)
+(define fileno/stdout)
+
+(define open-input-file*)
+(define open-output-file*)
+
+(define open/append)
+(define open/binary)
+(define open/creat)
+(define open/excl)
+(define open/fsync)
+(define open/noctty)
+(define open/noinherit)
+(define open/nonblock)
+(define open/rdonly)
+(define open/rdwr)
+(define open/read)
+(define open/sync)
+(define open/text)
+(define open/trunc)
+(define open/write)
+(define open/wronly)
+
+(define perm/irgrp)
+(define perm/iroth)
+(define perm/irusr)
+(define perm/irwxg)
+(define perm/irwxo)
+(define perm/irwxu)
+(define perm/isgid)
+(define perm/isuid)
+(define perm/isvtx)
+(define perm/iwgrp)
+(define perm/iwoth)
+(define perm/iwusr)
+(define perm/ixgrp)
+(define perm/ixoth)
+(define perm/ixusr)
+
+(define port->fileno)
+
+(define seek/cur)
+(define seek/end)
+(define seek/set)
+
+(define set-file-group!)
+(define set-file-owner!)
+(define set-file-permissions!)
+(define set-file-position!)
+(define set-file-times!)
+) ; chicken.file.posix
+
+;; This module really does nothing. It is used to keep all the posix
+;; stuff in one place, in a clean namespace. The included file will
+;; set! values from the modules defined above.
(module chicken.posix
- (block-device? call-with-input-pipe call-with-output-pipe
- change-directory* character-device? close-input-pipe
- close-output-pipe create-fifo create-pipe
- create-session create-symbolic-link
+ (call-with-input-pipe call-with-output-pipe
+ change-directory* close-input-pipe
+ close-output-pipe create-pipe create-session
current-effective-group-id current-effective-user-id
current-effective-user-name current-group-id current-process-id
current-user-id current-user-name
- directory? duplicate-fileno fcntl/dupfd fcntl/getfd
- fcntl/getfl fcntl/setfd fcntl/setfl fifo? file-access-time
- file-change-time file-close file-control file-creation-mode
- file-group file-link file-lock
- file-lock/blocking file-mkstemp file-modification-time file-open
- file-owner file-permissions file-position file-read
- file-select file-size file-stat file-test-lock file-truncate
- file-type file-unlock file-write fileno/stderr
- fileno/stdin fileno/stdout
local-time->seconds local-timezone-abbreviation
- open-input-file* open-input-pipe open-output-file* open-output-pipe
- open/append open/binary open/creat open/excl open/fsync open/noctty
- open/noinherit open/nonblock open/rdonly open/rdwr open/read
- open/sync open/text open/trunc open/write open/wronly
- parent-process-id perm/irgrp perm/iroth perm/irusr perm/irwxg
- perm/irwxo perm/irwxu perm/isgid perm/isuid perm/isvtx perm/iwgrp
- perm/iwoth perm/iwusr perm/ixgrp perm/ixoth perm/ixusr pipe/buf
- port->fileno process process* process-execute process-fork
+ open-input-pipe open-output-pipe
+ parent-process-id
+ process process* process-execute process-fork
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-file-group! set-file-owner!
- set-file-permissions! set-file-position! set-file-times!
+ process-spawn process-wait
+ seconds->local-time seconds->string seconds->utc-time set-alarm!
set-root-directory! set-signal-handler! set-signal-mask!
signal-handler signal-mask signal-mask! signal-masked? signal-unmask!
signal/abrt signal/alrm signal/break signal/bus signal/chld
@@ -81,8 +185,8 @@
signal/kill signal/pipe signal/prof signal/quit signal/segv
signal/stop signal/term signal/trap signal/tstp signal/urg
signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu
- signal/xfsz signals-list socket? spawn/detach spawn/nowait
- spawn/nowaito spawn/overlay spawn/wait string->time symbolic-link?
+ signal/xfsz signals-list spawn/detach spawn/nowait
+ spawn/nowaito spawn/overlay spawn/wait string->time
time->string user-information
utc-time->seconds with-input-from-pipe with-output-to-pipe)
@@ -150,125 +254,6 @@
(define errno/xdev _exdev)
) ; chicken.errno
-(module chicken.file.posix
- (create-fifo create-symbolic-link read-symbolic-link
- duplicate-fileno fcntl/dupfd fcntl/getfd fcntl/getfl fcntl/setfd
- fcntl/setfl file-access-time file-change-time file-modification-time
- file-close file-control file-creation-mode file-group file-link
- file-lock file-lock/blocking file-mkstemp file-open file-owner
- file-permissions file-position file-read file-select file-size
- file-stat file-test-lock file-truncate file-unlock file-write
- file-type block-device? character-device? directory? fifo?
- regular-file? socket? symbolic-link?
- fileno/stderr fileno/stdin fileno/stdout
- open-input-file* open-output-file*
- open/append open/binary open/creat open/excl open/fsync open/noctty
- open/noinherit open/nonblock open/rdonly open/rdwr open/read
- open/sync open/text open/trunc open/write open/wronly
- perm/irgrp perm/iroth perm/irusr perm/irwxg perm/irwxo perm/irwxu
- perm/isgid perm/isuid perm/isvtx perm/iwgrp perm/iwoth perm/iwusr
- perm/ixgrp perm/ixoth perm/ixusr
- port->fileno seek/cur seek/end seek/set set-file-group! set-file-owner!
- set-file-permissions! set-file-position! set-file-times!)
-
-(import scheme)
-
-(define create-fifo chicken.posix#create-fifo)
-(define create-symbolic-link chicken.posix#create-symbolic-link)
-(define read-symbolic-link chicken.posix#read-symbolic-link)
-(define duplicate-fileno chicken.posix#duplicate-fileno)
-
-(define fcntl/dupfd chicken.posix#fcntl/dupfd)
-(define fcntl/getfd chicken.posix#fcntl/getfd)
-(define fcntl/getfl chicken.posix#fcntl/getfl)
-(define fcntl/setfd chicken.posix#fcntl/setfd)
-(define fcntl/setfl chicken.posix#fcntl/setfl)
-
-(define file-access-time chicken.posix#file-access-time)
-(define file-change-time chicken.posix#file-change-time)
-(define file-modification-time chicken.posix#file-modification-time)
-(define file-close chicken.posix#file-close)
-(define file-control chicken.posix#file-control)
-(define file-creation-mode chicken.posix#file-creation-mode)
-(define file-group chicken.posix#file-group)
-(define file-link chicken.posix#file-link)
-(define file-lock chicken.posix#file-lock)
-(define file-lock/blocking chicken.posix#file-lock/blocking)
-(define file-mkstemp chicken.posix#file-mkstemp)
-(define file-open chicken.posix#file-open)
-(define file-owner chicken.posix#file-owner)
-(define file-permissions chicken.posix#file-permissions)
-(define file-position chicken.posix#file-position)
-(define file-read chicken.posix#file-read)
-(define file-select chicken.posix#file-select)
-(define file-size chicken.posix#file-size)
-(define file-stat chicken.posix#file-stat)
-(define file-test-lock chicken.posix#file-test-lock)
-(define file-truncate chicken.posix#file-truncate)
-(define file-unlock chicken.posix#file-unlock)
-(define file-write chicken.posix#file-write)
-(define file-type chicken.posix#file-type)
-
-(define block-device? chicken.posix#block-device?)
-(define character-device? chicken.posix#character-device?)
-(define directory? chicken.posix#directory?)
-(define fifo? chicken.posix#fifo?)
-(define regular-file? chicken.posix#regular-file?)
-(define socket? chicken.posix#socket?)
-(define symbolic-link? chicken.posix#symbolic-link?)
-
-(define fileno/stderr chicken.posix#fileno/stderr)
-(define fileno/stdin chicken.posix#fileno/stdin)
-(define fileno/stdout chicken.posix#fileno/stdout)
-
-(define open-input-file* chicken.posix#open-input-file*)
-(define open-output-file* chicken.posix#open-output-file*)
-
-(define open/append chicken.posix#open/append)
-(define open/binary chicken.posix#open/binary)
-(define open/creat chicken.posix#open/creat)
-(define open/excl chicken.posix#open/excl)
-(define open/fsync chicken.posix#open/fsync)
-(define open/noctty chicken.posix#open/noctty)
-(define open/noinherit chicken.posix#open/noinherit)
-(define open/nonblock chicken.posix#open/nonblock)
-(define open/rdonly chicken.posix#open/rdonly)
-(define open/rdwr chicken.posix#open/rdwr)
-(define open/read chicken.posix#open/read)
-(define open/sync chicken.posix#open/sync)
-(define open/text chicken.posix#open/text)
-(define open/trunc chicken.posix#open/trunc)
-(define open/write chicken.posix#open/write)
-(define open/wronly chicken.posix#open/wronly)
-
-(define perm/irgrp chicken.posix#perm/irgrp)
-(define perm/iroth chicken.posix#perm/iroth)
-(define perm/irusr chicken.posix#perm/irusr)
-(define perm/irwxg chicken.posix#perm/irwxg)
-(define perm/irwxo chicken.posix#perm/irwxo)
-(define perm/irwxu chicken.posix#perm/irwxu)
-(define perm/isgid chicken.posix#perm/isgid)
-(define perm/isuid chicken.posix#perm/isuid)
-(define perm/isvtx chicken.posix#perm/isvtx)
-(define perm/iwgrp chicken.posix#perm/iwgrp)
-(define perm/iwoth chicken.posix#perm/iwoth)
-(define perm/iwusr chicken.posix#perm/iwusr)
-(define perm/ixgrp chicken.posix#perm/ixgrp)
-(define perm/ixoth chicken.posix#perm/ixoth)
-(define perm/ixusr chicken.posix#perm/ixusr)
-
-(define port->fileno chicken.posix#port->fileno)
-
-(define seek/cur chicken.posix#seek/cur)
-(define seek/end chicken.posix#seek/end)
-(define seek/set chicken.posix#seek/set)
-
-(define set-file-group! chicken.posix#set-file-group!)
-(define set-file-owner! chicken.posix#set-file-owner!)
-(define set-file-permissions! chicken.posix#set-file-permissions!)
-(define set-file-position! chicken.posix#set-file-position!)
-(define set-file-times! chicken.posix#set-file-times!)
-) ; chicken.file.posix
(module chicken.time.posix
(seconds->utc-time utc-time->seconds seconds->local-time
diff --git a/posixunix.scm b/posixunix.scm
index e66144fb..61943ac8 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -282,26 +282,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
return utime(filename, &tb);
}
-static C_word C_i_fifo_p(C_word name)
-{
- struct stat buf;
- int res;
-
- res = stat(C_c_string(name), &buf);
-
- if(res != 0) {
-#ifdef __CYGWIN__
- return C_SCHEME_FALSE;
-#else
- if(errno == ENOENT) return C_fix(0);
- else return C_fix(res);
-#endif
- }
-
- if((buf.st_mode & S_IFMT) == S_IFIFO) return C_SCHEME_TRUE;
- else return C_SCHEME_FALSE;
-}
-
<#
;; Faster versions of common operations
@@ -326,82 +306,38 @@ static C_word C_i_fifo_p(C_word name)
(define-foreign-variable _f_getfl int "F_GETFL")
(define-foreign-variable _f_setfl int "F_SETFL")
-(define fcntl/dupfd _f_dupfd)
-(define fcntl/getfd _f_getfd)
-(define fcntl/setfd _f_setfd)
-(define fcntl/getfl _f_getfl)
-(define fcntl/setfl _f_setfl)
-
-(define-foreign-variable _o_rdonly int "O_RDONLY")
-(define-foreign-variable _o_wronly int "O_WRONLY")
-(define-foreign-variable _o_rdwr int "O_RDWR")
-(define-foreign-variable _o_creat int "O_CREAT")
-(define-foreign-variable _o_append int "O_APPEND")
-(define-foreign-variable _o_excl int "O_EXCL")
-(define-foreign-variable _o_noctty int "O_NOCTTY")
+(set! chicken.file.posix#fcntl/dupfd _f_dupfd)
+(set! chicken.file.posix#fcntl/getfd _f_getfd)
+(set! chicken.file.posix#fcntl/setfd _f_setfd)
+(set! chicken.file.posix#fcntl/getfl _f_getfl)
+(set! chicken.file.posix#fcntl/setfl _f_setfl)
+
(define-foreign-variable _o_nonblock int "O_NONBLOCK")
-(define-foreign-variable _o_trunc int "O_TRUNC")
+(define-foreign-variable _o_noctty int "O_NOCTTY")
(define-foreign-variable _o_fsync int "O_FSYNC")
-(define-foreign-variable _o_binary int "O_BINARY")
-(define-foreign-variable _o_text int "O_TEXT")
-
-(define open/rdonly _o_rdonly)
-(define open/wronly _o_wronly)
-(define open/rdwr _o_rdwr)
-(define open/read _o_rdonly)
-(define open/write _o_wronly)
-(define open/creat _o_creat)
-(define open/append _o_append)
-(define open/excl _o_excl)
-(define open/noctty _o_noctty)
-(define open/nonblock _o_nonblock)
-(define open/trunc _o_trunc)
-(define open/sync _o_fsync)
-(define open/fsync _o_fsync)
-(define open/binary _o_binary)
-(define open/text _o_text)
+(define-foreign-variable _o_sync int "O_SYNC")
+(set! chicken.file.posix#open/nonblock _o_nonblock)
+(set! chicken.file.posix#open/noctty _o_noctty)
+(set! chicken.file.posix#open/fsync _o_fsync)
+(set! chicken.file.posix#open/sync _o_sync)
;; Windows-only definitions
-(define open/noinherit 0)
+(set! chicken.file.posix#open/noinherit 0)
+
(define spawn/overlay 0)
(define spawn/wait 0)
(define spawn/nowait 0)
(define spawn/nowaito 0)
(define spawn/detach 0)
-(define-foreign-variable _s_irusr int "S_IRUSR")
-(define-foreign-variable _s_iwusr int "S_IWUSR")
-(define-foreign-variable _s_ixusr int "S_IXUSR")
-(define-foreign-variable _s_irgrp int "S_IRGRP")
-(define-foreign-variable _s_iwgrp int "S_IWGRP")
-(define-foreign-variable _s_ixgrp int "S_IXGRP")
-(define-foreign-variable _s_iroth int "S_IROTH")
-(define-foreign-variable _s_iwoth int "S_IWOTH")
-(define-foreign-variable _s_ixoth int "S_IXOTH")
-(define-foreign-variable _s_irwxu int "S_IRWXU")
-(define-foreign-variable _s_irwxg int "S_IRWXG")
-(define-foreign-variable _s_irwxo int "S_IRWXO")
(define-foreign-variable _s_isuid int "S_ISUID")
(define-foreign-variable _s_isgid int "S_ISGID")
(define-foreign-variable _s_isvtx int "S_ISVTX")
+(set! chicken.file.posix#perm/isvtx _s_isvtx)
+(set! chicken.file.posix#perm/isuid _s_isuid)
+(set! chicken.file.posix#perm/isgid _s_isgid)
-(define perm/irusr _s_irusr)
-(define perm/iwusr _s_iwusr)
-(define perm/ixusr _s_ixusr)
-(define perm/irgrp _s_irgrp)
-(define perm/iwgrp _s_iwgrp)
-(define perm/ixgrp _s_ixgrp)
-(define perm/iroth _s_iroth)
-(define perm/iwoth _s_iwoth)
-(define perm/ixoth _s_ixoth)
-(define perm/irwxu _s_irwxu)
-(define perm/irwxg _s_irwxg)
-(define perm/irwxo _s_irwxo)
-(define perm/isvtx _s_isvtx)
-(define perm/isuid _s_isuid)
-(define perm/isgid _s_isgid)
-
-(define file-control
+(set! chicken.file.posix#file-control
(let ([fcntl (foreign-lambda int fcntl int int long)])
(lambda (fd cmd #!optional (arg 0))
(##sys#check-fixnum fd 'file-control)
@@ -411,8 +347,8 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:file-error 'file-control "cannot control file" fd cmd)
res ) ) ) ) )
-(define file-open
- (let ([defmode (bitwise-ior _s_irwxu (bitwise-ior _s_irgrp _s_iroth))] )
+(set! chicken.file.posix#file-open
+ (let ((defmode (bitwise-ior _s_irwxu (bitwise-ior _s_irgrp _s_iroth))) )
(lambda (filename flags . mode)
(let ([mode (if (pair? mode) (car mode) defmode)])
(##sys#check-string filename 'file-open)
@@ -423,7 +359,7 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:file-error 'file-open "cannot open file" filename flags mode) )
fd) ) ) ) )
-(define file-close
+(set! chicken.file.posix#file-close
(lambda (fd)
(##sys#check-fixnum fd 'file-close)
(let loop ()
@@ -433,7 +369,7 @@ static C_word C_i_fifo_p(C_word name)
(else
(posix-error #:file-error 'file-close "cannot close file" fd)))))))
-(define file-read
+(set! chicken.file.posix#file-read
(lambda (fd size . buffer)
(##sys#check-fixnum fd 'file-read)
(##sys#check-fixnum size 'file-read)
@@ -445,7 +381,7 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:file-error 'file-read "cannot read from file" fd size) )
(list buf n) ) ) ) )
-(define file-write
+(set! chicken.file.posix#file-write
(lambda (fd buffer . size)
(##sys#check-fixnum fd 'file-write)
(unless (and (##core#inline "C_blockp" buffer) (##core#inline "C_byteblockp" buffer))
@@ -457,7 +393,7 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:file-error 'file-write "cannot write to file" fd size) )
n) ) ) )
-(define file-mkstemp
+(set! chicken.file.posix#file-mkstemp
(lambda (template)
(##sys#check-string template 'file-mkstemp)
(let* ([buf (##sys#make-c-string template 'file-mkstemp)]
@@ -470,59 +406,60 @@ static C_word C_i_fifo_p(C_word name)
;;; I/O multiplexing:
-(define (file-select fdsr fdsw . timeout)
- (let* ((tm (if (pair? timeout) (car timeout) #f))
- (fdsrl (cond ((not fdsr) '())
- ((fixnum? fdsr) (list fdsr))
- (else (##sys#check-list fdsr 'file-select)
- fdsr)))
- (fdswl (cond ((not fdsw) '())
- ((fixnum? fdsw) (list fdsw))
- (else (##sys#check-list fdsw 'file-select)
- fdsw)))
- (nfdsr (##sys#length fdsrl))
- (nfdsw (##sys#length fdswl))
- (nfds (fx+ nfdsr nfdsw))
- (fds-blob (##sys#make-blob
- (fx* nfds (foreign-value "sizeof(struct pollfd)" int)))))
- (when tm (##sys#check-exact-integer tm))
- (do ((i 0 (fx+ i 1))
- (fdsrl fdsrl (cdr fdsrl)))
- ((null? fdsrl))
- ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p))
- "struct pollfd *fds = p;"
- "fds[i].fd = fd; fds[i].events = POLLIN;") i (car fdsrl) fds-blob))
- (do ((i nfdsr (fx+ i 1))
- (fdswl fdswl (cdr fdswl)))
- ((null? fdswl))
- ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p))
- "struct pollfd *fds = p;"
- "fds[i].fd = fd; fds[i].events = POLLOUT;") i (car fdswl) fds-blob))
- (let ((n ((foreign-lambda int "poll" scheme-pointer int int)
- fds-blob nfds (if tm (* (max 0 tm) 1000) -1))))
- (cond ((fx< n 0)
- (posix-error #:file-error 'file-select "failed" fdsr fdsw) )
- ((fx= n 0) (values (if (pair? fdsr) '() #f) (if (pair? fdsw) '() #f)))
- (else
- (let ((rl (let lp ((i 0) (res '()) (fds fdsrl))
- (cond ((null? fds) (##sys#fast-reverse res))
- (((foreign-lambda* bool ((int i) (scheme-pointer p))
- "struct pollfd *fds = p;"
- "C_return(fds[i].revents & (POLLIN|POLLERR|POLLHUP|POLLNVAL));")
- i fds-blob)
- (lp (fx+ i 1) (cons (car fds) res) (cdr fds)))
- (else (lp (fx+ i 1) res (cdr fds))))))
- (wl (let lp ((i nfdsr) (res '()) (fds fdswl))
- (cond ((null? fds) (##sys#fast-reverse res))
- (((foreign-lambda* bool ((int i) (scheme-pointer p))
- "struct pollfd *fds = p;"
- "C_return(fds[i].revents & (POLLOUT|POLLERR|POLLHUP|POLLNVAL));")
- i fds-blob)
- (lp (fx+ i 1) (cons (car fds) res) (cdr fds)))
- (else (lp (fx+ i 1) res (cdr fds)))))))
- (values
- (and fdsr (if (fixnum? fdsr) (and (memq fdsr rl) fdsr) rl))
- (and fdsw (if (fixnum? fdsw) (and (memq fdsw wl) fdsw) wl)))))))))
+(set! chicken.file.posix#file-select
+ (lambda (fdsr fdsw . timeout)
+ (let* ((tm (if (pair? timeout) (car timeout) #f))
+ (fdsrl (cond ((not fdsr) '())
+ ((fixnum? fdsr) (list fdsr))
+ (else (##sys#check-list fdsr 'file-select)
+ fdsr)))
+ (fdswl (cond ((not fdsw) '())
+ ((fixnum? fdsw) (list fdsw))
+ (else (##sys#check-list fdsw 'file-select)
+ fdsw)))
+ (nfdsr (##sys#length fdsrl))
+ (nfdsw (##sys#length fdswl))
+ (nfds (fx+ nfdsr nfdsw))
+ (fds-blob (##sys#make-blob
+ (fx* nfds (foreign-value "sizeof(struct pollfd)" int)))))
+ (when tm (##sys#check-exact-integer tm))
+ (do ((i 0 (fx+ i 1))
+ (fdsrl fdsrl (cdr fdsrl)))
+ ((null? fdsrl))
+ ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p))
+ "struct pollfd *fds = p;"
+ "fds[i].fd = fd; fds[i].events = POLLIN;") i (car fdsrl) fds-blob))
+ (do ((i nfdsr (fx+ i 1))
+ (fdswl fdswl (cdr fdswl)))
+ ((null? fdswl))
+ ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p))
+ "struct pollfd *fds = p;"
+ "fds[i].fd = fd; fds[i].events = POLLOUT;") i (car fdswl) fds-blob))
+ (let ((n ((foreign-lambda int "poll" scheme-pointer int int)
+ fds-blob nfds (if tm (* (max 0 tm) 1000) -1))))
+ (cond ((fx< n 0)
+ (posix-error #:file-error 'file-select "failed" fdsr fdsw) )
+ ((fx= n 0) (values (if (pair? fdsr) '() #f) (if (pair? fdsw) '() #f)))
+ (else
+ (let ((rl (let lp ((i 0) (res '()) (fds fdsrl))
+ (cond ((null? fds) (##sys#fast-reverse res))
+ (((foreign-lambda* bool ((int i) (scheme-pointer p))
+ "struct pollfd *fds = p;"
+ "C_return(fds[i].revents & (POLLIN|POLLERR|POLLHUP|POLLNVAL));")
+ i fds-blob)
+ (lp (fx+ i 1) (cons (car fds) res) (cdr fds)))
+ (else (lp (fx+ i 1) res (cdr fds))))))
+ (wl (let lp ((i nfdsr) (res '()) (fds fdswl))
+ (cond ((null? fds) (##sys#fast-reverse res))
+ (((foreign-lambda* bool ((int i) (scheme-pointer p))
+ "struct pollfd *fds = p;"
+ "C_return(fds[i].revents & (POLLOUT|POLLERR|POLLHUP|POLLNVAL));")
+ i fds-blob)
+ (lp (fx+ i 1) (cons (car fds) res) (cdr fds)))
+ (else (lp (fx+ i 1) res (cdr fds)))))))
+ (values
+ (and fdsr (if (fixnum? fdsr) (and (memq fdsr rl) fdsr) rl))
+ (and fdsw (if (fixnum? fdsw) (and (memq fdsw wl) fdsw) wl))))))))))
;;; Pipes:
@@ -808,7 +745,7 @@ static C_word C_i_fifo_p(C_word name)
(##sys#check-fixnum gid loc)
(let ((r (cond
((port? f)
- (##core#inline "C_fchown" (port->fileno f) uid gid))
+ (##core#inline "C_fchown" (chicken.file.posix#port->fileno f) uid gid))
((fixnum? f)
(##core#inline "C_fchown" f uid gid))
((string? f)
@@ -847,7 +784,7 @@ static C_word C_i_fifo_p(C_word name)
;;; Hard and symbolic links:
-(define create-symbolic-link
+(set! chicken.file.posix#create-symbolic-link
(lambda (old new)
(##sys#check-string old 'create-symbolic-link)
(##sys#check-string new 'create-symbolic-link)
@@ -870,27 +807,28 @@ static C_word C_i_fifo_p(C_word name)
(posix-error #:file-error location "cannot read symbolic link" fname)
(substring buf 0 len))))))
-(define (read-symbolic-link fname #!optional canonicalize)
- (##sys#check-string fname 'read-symbolic-link)
- (if canonicalize
- (receive (base-origin base-directory directory-components) (decompose-directory fname)
- (let loop ((components directory-components)
- (result (string-append (or base-origin "") (or base-directory ""))))
- (if (null? components)
- result
- (let ((pathname (make-pathname result (car components))))
- (if (##sys#file-exists? pathname #f #f 'read-symbolic-link)
- (loop (cdr components)
- (if (symbolic-link? pathname)
- (let ((target (##sys#read-symbolic-link pathname 'read-symbolic-link)))
- (if (absolute-pathname? target)
- target
- (make-pathname result target)))
- pathname))
- (##sys#signal-hook #:file-error 'read-symbolic-link "could not canonicalize path with symbolic links, component does not exist" pathname))))))
- (##sys#read-symbolic-link fname 'read-symbolic-link)))
-
-(define file-link
+(set! chicken.file.posix#read-symbolic-link
+ (lambda (fname #!optional canonicalize)
+ (##sys#check-string fname 'read-symbolic-link)
+ (if canonicalize
+ (receive (base-origin base-directory directory-components) (decompose-directory fname)
+ (let loop ((components directory-components)
+ (result (string-append (or base-origin "") (or base-directory ""))))
+ (if (null? components)
+ result
+ (let ((pathname (make-pathname result (car components))))
+ (if (##sys#file-exists? pathname #f #f 'read-symbolic-link)
+ (loop (cdr components)
+ (if (chicken.file.posix#symbolic-link? pathname)
+ (let ((target (##sys#read-symbolic-link pathname 'read-symbolic-link)))
+ (if (absolute-pathname? target)
+ target
+ (make-pathname result target)))
+ pathname))
+ (##sys#signal-hook #:file-error 'read-symbolic-link "could not canonicalize path with symbolic links, component does not exist" pathname))))))
+ (##sys#read-symbolic-link fname 'read-symbolic-link))))
+
+(set! chicken.file.posix#file-link
(let ([link (foreign-lambda int "link" c-string c-string)])
(lambda (old new)
(##sys#check-string old 'file-link)
@@ -1085,7 +1023,7 @@ static C_word C_i_fifo_p(C_word name)
;;; Other file operations:
-(define file-truncate
+(set! chicken.file.posix#file-truncate
(lambda (fname off)
(##sys#check-exact-integer off 'file-truncate)
(when (fx< (cond [(string? fname) (##core#inline "C_truncate" (##sys#make-c-string fname 'file-truncate) off)]
@@ -1101,10 +1039,6 @@ static C_word C_i_fifo_p(C_word name)
(define-foreign-variable _f_rdlck int "F_RDLCK")
(define-foreign-variable _f_unlck int "F_UNLCK")
-(define file-lock)
-(define file-lock/blocking)
-(define file-test-lock)
-
(let ()
(define (setup port args loc)
(let-optionals* args ([start 0]
@@ -1118,7 +1052,7 @@ static C_word C_i_fifo_p(C_word name)
(##sys#make-structure 'lock port start len) ) )
(define (err msg lock loc)
(posix-error #:file-error loc msg (##sys#slot lock 1) (##sys#slot lock 2) (##sys#slot lock 3)) )
- (set! file-lock
+ (set! chicken.file.posix#file-lock
(lambda (port . args)
(let loop ()
(let ((lock (setup port args 'file-lock)))
@@ -1127,7 +1061,7 @@ static C_word C_i_fifo_p(C_word name)
((fx= _errno _eintr) (##sys#dispatch-interrupt loop))
(else (err "cannot lock file" lock 'file-lock)))
lock)))))
- (set! file-lock/blocking
+ (set! chicken.file.posix#file-lock/blocking
(lambda (port . args)
(let loop ()
(let ((lock (setup port args 'file-lock/blocking)))
@@ -1136,25 +1070,27 @@ static C_word C_i_fifo_p(C_word name)
((fx= _errno _eintr) (##sys#dispatch-interrupt loop))
(else (err "cannot lock file" lock 'file-lock/blocking)))
lock)))))
- (set! file-test-lock
+ (set! chicken.file.posix#file-test-lock
(lambda (port . args)
(let ([lock (setup port args 'file-test-lock)])
(cond [(##core#inline "C_flock_test" port) => (lambda (c) (and (not (fx= c 0)) c))]
[else (err "cannot unlock file" lock 'file-test-lock)] ) ) ) ) )
-(define file-unlock
+(set! chicken.file.posix#file-unlock
(lambda (lock)
(##sys#check-structure lock 'lock 'file-unlock)
(##core#inline "C_flock_setup" _f_unlck (##sys#slot lock 2) (##sys#slot lock 3))
(when (fx< (##core#inline "C_flock_lock" (##sys#slot lock 1)) 0)
(cond
- ((fx= _errno _eintr) (##sys#dispatch-interrupt (lambda () (file-unlock lock))))
- (else (posix-error #:file-error 'file-unlock "cannot unlock file" lock))))))
+ ((fx= _errno _eintr)
+ (##sys#dispatch-interrupt
+ (lambda () (chicken.file.posix#file-unlock lock))))
+ (else (posix-error #:file-error 'file-unlock "cannot unlock file" lock))))))
;;; FIFOs:
-(define create-fifo
+(set! chicken.file.posix#create-fifo
(lambda (fname . mode)
(##sys#check-string fname 'create-fifo)
(let ([mode (if (pair? mode) (car mode) (fxior _s_irwxu (fxior _s_irwxg _s_irwxo)))])
@@ -1162,20 +1098,6 @@ static C_word C_i_fifo_p(C_word name)
(when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string fname 'create-fifo) mode) 0)
(posix-error #:file-error 'create-fifo "cannot create FIFO" fname mode) ) ) ) )
-(define fifo?
- (lambda (filename)
- (##sys#check-string filename 'fifo?)
- (case (##core#inline
- "C_i_fifo_p"
- (##sys#make-c-string filename 'fifo?))
- ((#t) #t)
- ((#f) #f)
- ((0) (##sys#signal-hook #:file-error 'fifo? "file does not exist" filename) )
- (else
- (posix-error
- #:file-error 'fifo?
- "system error while trying to access file" filename) ) ) ) )
-
;;; Time related things:
@@ -1306,12 +1228,11 @@ static C_word C_i_fifo_p(C_word name)
;FIXME process-execute, process-fork don't show parent caller
(define ##sys#process
- (let (
- [replace-fd
- (lambda (loc fd stdfd)
- (unless (fx= stdfd fd)
- (duplicate-fileno fd stdfd)
- (file-close fd) ) )] )
+ (let ((replace-fd
+ (lambda (loc fd stdfd)
+ (unless (fx= stdfd fd)
+ (chicken.file.posix#duplicate-fileno fd stdfd)
+ (chicken.file.posix#file-close fd) ) )) )
(let (
[make-on-close
(lambda (loc pid clsvec idx idxa idxb)
@@ -1330,32 +1251,32 @@ static C_word C_i_fifo_p(C_word name)
(lambda (loc pipe port fd)
(and port
(let ([usefd (car pipe)] [clsfd (cdr pipe)])
- (file-close clsfd)
+ (chicken.file.posix#file-close clsfd)
usefd) ) )]
[connect-child
(lambda (loc pipe port stdfd)
(when port
(let ([usefd (car pipe)] [clsfd (cdr pipe)])
- (file-close clsfd)
+ (chicken.file.posix#file-close clsfd)
(replace-fd loc usefd stdfd)) ) )] )
(let (
- [spawn
- (let ([swapped-ends
- (lambda (pipe)
- (and pipe
- (cons (cdr pipe) (car pipe)) ) )])
- (lambda (loc cmd args env stdoutf stdinf stderrf)
- (let ([ipipe (needed-pipe loc stdinf)]
- [opipe (needed-pipe loc stdoutf)]
- [epipe (needed-pipe loc stderrf)])
- (values
- ipipe (swapped-ends opipe) epipe
- (process-fork
- (lambda ()
- (connect-child loc opipe stdinf fileno/stdin)
- (connect-child loc (swapped-ends ipipe) stdoutf fileno/stdout)
- (connect-child loc (swapped-ends epipe) stderrf fileno/stderr)
- (process-execute cmd args env)))) ) ) )]
+ (spawn
+ (let ([swapped-ends
+ (lambda (pipe)
+ (and pipe
+ (cons (cdr pipe) (car pipe)) ) )])
+ (lambda (loc cmd args env stdoutf stdinf stderrf)
+ (let ([ipipe (needed-pipe loc stdinf)]
+ [opipe (needed-pipe loc stdoutf)]
+ [epipe (needed-pipe loc stderrf)])
+ (values
+ ipipe (swapped-ends opipe) epipe
+ (process-fork
+ (lambda ()
+ (connect-child loc opipe stdinf chicken.file.posix#fileno/stdin)
+ (connect-child loc (swapped-ends ipipe) stdoutf chicken.file.posix#fileno/stdout)
+ (connect-child loc (swapped-ends epipe) stderrf chicken.file.posix#fileno/stderr)
+ (process-execute cmd args env)))) ) ) ))
[input-port
(lambda (loc pid cmd pipe stdf stdfd on-close)
(and-let* ([fd (connect-parent loc pipe stdf stdfd)])
@@ -1370,15 +1291,18 @@ static C_word C_i_fifo_p(C_word name)
;When shared assume already "closed", since only created ports
;should be explicitly closed, and when one is closed we want
;to wait.
- (let ([clsvec (vector (not stdinf) (not stdoutf) (not stderrf))])
+ (let ((clsvec (vector (not stdinf) (not stdoutf) (not stderrf))))
(values
- (input-port loc pid cmd inpipe stdinf fileno/stdin
- (make-on-close loc pid clsvec 0 1 2))
- (output-port loc pid cmd outpipe stdoutf fileno/stdout
- (make-on-close loc pid clsvec 1 0 2))
- pid
- (input-port loc pid cmd errpipe stderrf fileno/stderr
- (make-on-close loc pid clsvec 2 0 1)) ) ) ) ) ) ) ) )
+ (input-port loc pid cmd inpipe stdinf
+ chicken.file.posix#fileno/stdin
+ (make-on-close loc pid clsvec 0 1 2))
+ (output-port loc pid cmd outpipe stdoutf
+ chicken.file.posix#fileno/stdout
+ (make-on-close loc pid clsvec 1 0 2))
+ pid
+ (input-port loc pid cmd errpipe stderrf
+ chicken.file.posix#fileno/stderr
+ (make-on-close loc pid clsvec 2 0 1)) ) ) ) ) ) ) ) )
;;; Run subprocess connected with pipes:
diff --git a/posixwin.scm b/posixwin.scm
index 574367a1..bccb2ce0 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -30,7 +30,6 @@
; open/noctty open/nonblock open/fsync open/sync
; perm/isvtx perm/isuid perm/isgid
; file-select
-; symbolic-link?
; set-signal-mask! signal-mask signal-masked? signal-mask! signal-unmask!
; user-information
; change-file-owner
@@ -42,7 +41,7 @@
; create-symbolic-link read-symbolic-link
; file-truncate
; file-lock file-lock/blocking file-unlock file-test-lock
-; create-fifo fifo?
+; create-fifo
; prot/...
; map/...
; set-alarm!
@@ -518,58 +517,11 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define pipe/buf _pipe_buf)
-(define-foreign-variable _o_rdonly int "O_RDONLY")
-(define-foreign-variable _o_wronly int "O_WRONLY")
-(define-foreign-variable _o_rdwr int "O_RDWR")
-(define-foreign-variable _o_creat int "O_CREAT")
-(define-foreign-variable _o_append int "O_APPEND")
-(define-foreign-variable _o_excl int "O_EXCL")
-(define-foreign-variable _o_trunc int "O_TRUNC")
-(define-foreign-variable _o_binary int "O_BINARY")
-(define-foreign-variable _o_text int "O_TEXT")
(define-foreign-variable _o_noinherit int "O_NOINHERIT")
+(set! chicken.file.posix#open/noinherit _o_noinherit)
-(define open/rdonly _o_rdonly)
-(define open/wronly _o_wronly)
-(define open/rdwr _o_rdwr)
-(define open/read _o_rdwr)
-(define open/write _o_wronly)
-(define open/creat _o_creat)
-(define open/append _o_append)
-(define open/excl _o_excl)
-(define open/trunc _o_trunc)
-(define open/binary _o_binary)
-(define open/text _o_text)
-(define open/noinherit _o_noinherit)
-
-(define-foreign-variable _s_irusr int "S_IREAD")
-(define-foreign-variable _s_iwusr int "S_IWRITE")
-(define-foreign-variable _s_ixusr int "S_IEXEC")
-(define-foreign-variable _s_irgrp int "S_IREAD")
-(define-foreign-variable _s_iwgrp int "S_IWRITE")
-(define-foreign-variable _s_ixgrp int "S_IEXEC")
-(define-foreign-variable _s_iroth int "S_IREAD")
-(define-foreign-variable _s_iwoth int "S_IWRITE")
-(define-foreign-variable _s_ixoth int "S_IEXEC")
-(define-foreign-variable _s_irwxu int "S_IREAD | S_IWRITE | S_IEXEC")
-(define-foreign-variable _s_irwxg int "S_IREAD | S_IWRITE | S_IEXEC")
-(define-foreign-variable _s_irwxo int "S_IREAD | S_IWRITE | S_IEXEC")
-
-(define perm/irusr _s_irusr)
-(define perm/iwusr _s_iwusr)
-(define perm/ixusr _s_ixusr)
-(define perm/irgrp _s_irgrp)
-(define perm/iwgrp _s_iwgrp)
-(define perm/ixgrp _s_ixgrp)
-(define perm/iroth _s_iroth)
-(define perm/iwoth _s_iwoth)
-(define perm/ixoth _s_ixoth)
-(define perm/irwxu _s_irwxu)
-(define perm/irwxg _s_irwxg)
-(define perm/irwxo _s_irwxo)
-
-(define file-open
- (let ([defmode (bitwise-ior _s_irwxu (fxior _s_irgrp _s_iroth))] )
+(set! chicken.file.posix#file-open
+ (let ((defmode (bitwise-ior _s_irwxu (fxior _s_irgrp _s_iroth))))
(lambda (filename flags . mode)
(let ([mode (if (pair? mode) (car mode) defmode)])
(##sys#check-string filename 'file-open)
@@ -581,7 +533,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##sys#signal-hook #:file-error 'file-open "cannot open file" filename flags mode) )
fd) ) ) ) )
-(define file-close
+(set! chicken.file.posix#file-close
(lambda (fd)
(##sys#check-fixnum fd 'file-close)
(let loop ()
@@ -591,7 +543,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(else
(posix-error #:file-error 'file-close "cannot close file" fd)))))))
-(define file-read
+(set! chicken.file.posix#file-read
(lambda (fd size . buffer)
(##sys#check-fixnum fd 'file-read)
(##sys#check-fixnum size 'file-read)
@@ -604,7 +556,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##sys#signal-hook #:file-error 'file-read "cannot read from file" fd size) )
(list buf n) ) ) ) )
-(define file-write
+(set! chicken.file.posix#file-write
(lambda (fd buffer . size)
(##sys#check-fixnum fd 'file-write)
(unless (and (##core#inline "C_blockp" buffer) (##core#inline "C_byteblockp" buffer))
@@ -617,7 +569,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##sys#signal-hook #:file-error 'file-write "cannot write to file" fd size) )
n) ) ) )
-(define file-mkstemp
+(set! chicken.file.posix#file-mkstemp
(lambda (template)
(##sys#check-string template 'file-mkstemp)
(let* ((diz "0123456789abcdefghijklmnopqrstuvwxyz")
@@ -645,7 +597,9 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(suffix-loop (fx- index 1))))
(let ((fd (##core#inline "C_open"
(##sys#make-c-string tmpl 'file-open)
- (bitwise-ior open/rdwr open/creat open/excl)
+ (bitwise-ior chicken.file.posix#open/rdwr
+ chicken.file.posix#open/creat
+ chicken.file.posix#open/excl)
(fxior _s_irusr _s_iwusr))))
(if (eq? -1 fd)
(if (fx< count max-attempts)
@@ -751,7 +705,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define-foreign-variable _pipefd0 int "C_pipefds[ 0 ]")
(define-foreign-variable _pipefd1 int "C_pipefds[ 1 ]")
-(define (create-pipe #!optional (mode (fxior open/binary open/noinherit)))
+(define (create-pipe #!optional (mode (fxior chicken.file.posix#open/binary chicken.file.posix#open/noinherit)))
(when (fx< (##core#inline "C_pipe" #f mode) 0)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'create-pipe "cannot create pipe") )
@@ -804,52 +758,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; Using file-descriptors:
-(define-foreign-variable _stdin_fileno int "0")
-(define-foreign-variable _stdout_fileno int "1")
-(define-foreign-variable _stderr_fileno int "2")
-
-(define fileno/stdin _stdin_fileno)
-(define fileno/stdout _stdout_fileno)
-(define fileno/stderr _stderr_fileno)
-
-(let ()
- (define (mode inp m loc)
- (##sys#make-c-string
- (cond [(pair? m)
- (let ([m (car m)])
- (case m
- [(###append) (if (not inp) "a" (##sys#error "invalid mode for input file" m))]
- [else (##sys#error "invalid mode argument" m)] ) ) ]
- [inp "r"]
- [else "w"] )
- loc) )
- (define (check fd inp r)
- (##sys#update-errno)
- (if (##sys#null-pointer? r)
- (##sys#signal-hook #:file-error "cannot open file" fd)
- (let ((port (##sys#make-port (if inp 1 2) ##sys#stream-port-class "(fdport)" 'stream)))
- (##core#inline "C_set_file_ptr" port r)
- port) ) )
- (set! open-input-file*
- (lambda (fd . m)
- (##sys#check-fixnum fd 'open-input-file*)
- (check fd #t (##core#inline_allocate ("C_fdopen" 2) fd (mode #t m 'open-input-file*))) ) )
- (set! open-output-file*
- (lambda (fd . m)
- (##sys#check-fixnum fd 'open-output-file*)
- (check fd #f (##core#inline_allocate ("C_fdopen" 2) fd (mode #f m 'open-output-file*)) ) ) ) )
-
-(define port->fileno
- (lambda (port)
- (##sys#check-open-port port 'port->fileno)
- (if (not (zero? (##sys#peek-unsigned-integer port 0)))
- (let ([fd (##core#inline "C_port_fileno" port)])
- (when (fx< fd 0)
- (##sys#update-errno)
- (##sys#signal-hook #:file-error 'port->fileno "cannot access file-descriptor of port" port) )
- fd)
- (##sys#signal-hook #:type-error 'port->fileno "port has no attached file" port) ) ) )
-
(define duplicate-fileno
(lambda (old . new)
(##sys#check-fixnum old duplicate-fileno)
@@ -990,10 +898,13 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(+ (if stdinf 0 1) (if stdoutf 0 2) (if stderrf 0 4)))])
(if res
(values
- (and stdoutf (open-input-file* stdout_fd)) ;Parent stdin
- (and stdinf (open-output-file* stdin_fd)) ;Parent stdout
- handle
- (and stderrf (open-input-file* stderr_fd)))
+ (and stdoutf (chicken.file.posix#open-input-file*
+ stdout_fd)) ;Parent stdin
+ (and stdinf (chicken.file.posix#open-output-file*
+ stdin_fd)) ;Parent stdout
+ handle
+ (and stderrf (chicken.file.posix#open-input-file*
+ stderr_fd)))
(begin
(##sys#update-errno)
(##sys#signal-hook #:process-error loc "cannot execute process" cmdlin))) ) ) ) ) ) )
@@ -1049,27 +960,27 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; unimplemented stuff:
(define-unimplemented chown) ; covers set-file-group! and set-file-owner!
-(define-unimplemented create-fifo)
+(set!-unimplemented chicken.file.posix#create-fifo)
(define-unimplemented create-session)
-(define-unimplemented create-symbolic-link)
+(set!-unimplemented chicken.file.posix#create-symbolic-link)
(define-unimplemented current-effective-group-id)
(define-unimplemented current-effective-user-id)
(define-unimplemented current-effective-user-name)
(define-unimplemented current-group-id)
(define-unimplemented current-user-id)
-(define-unimplemented file-control)
-(define-unimplemented file-link)
-(define-unimplemented file-lock)
-(define-unimplemented file-lock/blocking)
-(define-unimplemented file-select)
-(define-unimplemented file-test-lock)
-(define-unimplemented file-truncate)
-(define-unimplemented file-unlock)
+(set!-unimplemented chicken.file.posix#file-control)
+(set!-unimplemented chicken.file.posix#file-link)
+(set!-unimplemented chicken.file.posix#file-lock)
+(set!-unimplemented chicken.file.posix#file-lock/blocking)
+(set!-unimplemented chicken.file.posix#file-select)
+(set!-unimplemented chicken.file.posix#file-test-lock)
+(set!-unimplemented chicken.file.posix#file-truncate)
+(set!-unimplemented chicken.file.posix#file-unlock)
(define-unimplemented parent-process-id)
(define-unimplemented process-fork)
(define-unimplemented process-group-id)
(define-unimplemented process-signal)
-(define-unimplemented read-symbolic-link)
+(set!-unimplemented chicken.file.posix#read-symbolic-link)
(define-unimplemented set-alarm!)
(define-unimplemented set-group-id!)
(define-unimplemented set-process-group-id!)
@@ -1084,17 +995,16 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define-unimplemented utc-time->seconds)
(define-unimplemented string->time)
-(define (fifo? _) #f)
-
-(define fcntl/dupfd 0)
-(define fcntl/getfd 0)
-(define fcntl/setfd 0)
-(define fcntl/getfl 0)
-(define fcntl/setfl 0)
-(define open/fsync 0)
-(define open/noctty 0)
-(define open/nonblock 0)
-(define open/sync 0)
-(define perm/isgid 0)
-(define perm/isuid 0)
-(define perm/isvtx 0)
+;; Unix-only definitions
+(set! chicken.file.posix#fcntl/dupfd 0)
+(set! chicken.file.posix#fcntl/getfd 0)
+(set! chicken.file.posix#fcntl/setfd 0)
+(set! chicken.file.posix#fcntl/getfl 0)
+(set! chicken.file.posix#fcntl/setfl 0)
+(set! chicken.file.posix#open/noctty 0)
+(set! chicken.file.posix#open/nonblock 0)
+(set! chicken.file.posix#open/fsync 0)
+(set! chicken.file.posix#open/sync 0)
+(set! chicken.file.posix#perm/isgid 0)
+(set! chicken.file.posix#perm/isuid 0)
+(set! chicken.file.posix#perm/isvtx 0)
diff --git a/types.db b/types.db
index 429b8f04..77f3d24c 100644
--- a/types.db
+++ b/types.db
@@ -1923,6 +1923,106 @@
(chicken.process-context#set-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#set-environment-variable! (string string) undefined))
(chicken.process-context#unset-environment-variable! (#(procedure #:clean #:enforce) chicken.process-context#unset-environment-variable! (string) undefined))
+;; file.posix
+
+(chicken.file.posix#create-fifo (#(procedure #:clean #:enforce) chicken.file.posix#create-fifo (string #!optional fixnum) undefined))
+(chicken.file.posix#create-symbolic-link (#(procedure #:clean #:enforce) chicken.file.posix#create-symbolic-link (string string) undefined))
+(chicken.file.posix#read-symbolic-link (#(procedure #:clean #:enforce) chicken.file.posix#read-symbolic-link (string #!optional boolean) string))
+(chicken.file.posix#duplicate-fileno (#(procedure #:clean #:enforce) chicken.file.posix#duplicate-fileno (fixnum #!optional fixnum) fixnum))
+
+(chicken.file.posix#fcntl/dupfd fixnum)
+(chicken.file.posix#fcntl/getfd fixnum)
+(chicken.file.posix#fcntl/getfl fixnum)
+(chicken.file.posix#fcntl/setfd fixnum)
+(chicken.file.posix#fcntl/setfl fixnum)
+
+(chicken.file.posix#file-access-time (#(procedure #:clean #:enforce) chicken.file.posix#file-access-time ((or string port fixnum)) integer))
+(chicken.file.posix#file-change-time (#(procedure #:clean #:enforce) chicken.file.posix#file-change-time ((or string port fixnum)) integer))
+(chicken.file.posix#file-modification-time (#(procedure #:clean #:enforce) chicken.file.posix#file-modification-time ((or string fixnum port)) integer))
+(chicken.file.posix#file-close (#(procedure #:clean #:enforce) chicken.file.posix#file-close (fixnum) undefined))
+(chicken.file.posix#file-control (#(procedure #:clean #:enforce) chicken.file.posix#file-control (fixnum fixnum #!optional fixnum) fixnum))
+(chicken.file.posix#file-creation-mode (#(procedure #:clean #:enforce) chicken.file.posix#file-creation-mode (#!optional fixnum) fixnum))
+(chicken.file.posix#file-group (#(procedure #:clean #:enforce) chicken.file.posix#file-owner ((or string fixnum)) fixnum))
+(chicken.file.posix#file-link (#(procedure #:clean #:enforce) chicken.file.posix#file-link (string string) undefined))
+(chicken.file.posix#file-lock (#(procedure #:clean #:enforce) chicken.file.posix#file-lock (port #!optional fixnum integer) (struct lock)))
+(chicken.file.posix#file-lock/blocking (#(procedure #:clean #:enforce) chicken.file.posix#file-lock/blocking (port #!optional fixnum integer) (struct lock)))
+(chicken.file.posix#file-mkstemp (#(procedure #:clean #:enforce) chicken.file.posix#file-mkstemp (string) fixnum string))
+(chicken.file.posix#file-open (#(procedure #:clean #:enforce) chicken.file.posix#file-open (string fixnum #!optional fixnum) fixnum))
+(chicken.file.posix#file-owner (#(procedure #:clean #:enforce) chicken.file.posix#file-owner ((or string fixnum)) fixnum))
+(chicken.file.posix#file-permissions (#(procedure #:clean #:enforce) chicken.file.posix#file-permissions ((or string fixnum)) fixnum))
+(chicken.file.posix#file-position (#(procedure #:clean #:enforce) chicken.file.posix#file-position ((or port fixnum)) integer))
+(chicken.file.posix#file-read (#(procedure #:clean #:enforce) chicken.file.posix#file-read (fixnum fixnum #!optional *) list))
+(chicken.file.posix#file-select (#(procedure #:clean #:enforce) chicken.file.posix#file-select ((or (list-of fixnum) fixnum false) (or (list-of fixnum) fixnum false) #!optional fixnum) * *))
+(chicken.file.posix#file-size (#(procedure #:clean #:enforce) chicken.file.posix#file-size ((or string fixnum)) integer))
+(chicken.file.posix#file-stat (#(procedure #:clean #:enforce) chicken.file.posix#file-stat ((or string fixnum) #!optional *) (vector-of integer)))
+(chicken.file.posix#file-test-lock (#(procedure #:clean #:enforce) chicken.file.posix#file-test-lock (port #!optional fixnum *) boolean))
+(chicken.file.posix#file-truncate (#(procedure #:clean #:enforce) chicken.file.posix#file-truncate ((or string fixnum) integer) undefined))
+(chicken.file.posix#file-unlock (#(procedure #:clean #:enforce) chicken.file.posix#file-unlock ((struct lock)) undefined))
+(chicken.file.posix#file-write (#(procedure #:clean #:enforce) chicken.file.posix#file-write (fixnum * #!optional fixnum) fixnum))
+(chicken.file.posix#file-type (#(procedure #:clean #:enforce) chicken.file.posix#file-type ((or string fixnum) #!optional * *) symbol))
+
+(chicken.file.posix#block-device? (#(procedure #:clean #:enforce) chicken.file.posix#block-device? ((or string fixnum)) boolean))
+(chicken.file.posix#character-device? (#(procedure #:clean #:enforce) chicken.file.posix#character-device? ((or string fixnum)) boolean))
+(chicken.file.posix#directory? (#(procedure #:clean #:enforce) chicken.file.posix#directory? ((or string fixnum)) boolean))
+(chicken.file.posix#fifo? (#(procedure #:clean #:enforce) chicken.file.posix#fifo? ((or string fixnum)) boolean))
+(chicken.file.posix#regular-file? (#(procedure #:clean #:enforce) chicken.file.posix#regular-file? ((or string fixnum)) boolean))
+(chicken.file.posix#socket? (#(procedure #:clean #:enforce) chicken.file.posix#socket? ((or string fixnum)) boolean))
+(chicken.file.posix#symbolic-link? (#(procedure #:clean #:enforce) chicken.file.posix#symbolic-link? ((or string fixnum)) boolean))
+
+(chicken.file.posix#fileno/stderr fixnum)
+(chicken.file.posix#fileno/stdin fixnum)
+(chicken.file.posix#fileno/stdout fixnum)
+
+(chicken.file.posix#open-input-file* (#(procedure #:clean #:enforce) chicken.file.posix#open-input-file* (fixnum #!optional symbol) input-port))
+(chicken.file.posix#open-output-file* (#(procedure #:clean #:enforce) chicken.file.posix#open-output-file* (fixnum #!optional symbol) output-port))
+
+(chicken.file.posix#open/append fixnum)
+(chicken.file.posix#open/binary fixnum)
+(chicken.file.posix#open/creat fixnum)
+(chicken.file.posix#open/excl fixnum)
+(chicken.file.posix#open/fsync fixnum)
+(chicken.file.posix#open/noctty fixnum)
+(chicken.file.posix#open/noinherit fixnum)
+(chicken.file.posix#open/nonblock fixnum)
+(chicken.file.posix#open/rdonly fixnum)
+(chicken.file.posix#open/rdwr fixnum)
+(chicken.file.posix#open/read fixnum)
+(chicken.file.posix#open/sync fixnum)
+(chicken.file.posix#open/text fixnum)
+(chicken.file.posix#open/trunc fixnum)
+(chicken.file.posix#open/write fixnum)
+(chicken.file.posix#open/wronly fixnum)
+
+(chicken.file.posix#perm/irgrp fixnum)
+(chicken.file.posix#perm/iroth fixnum)
+(chicken.file.posix#perm/irusr fixnum)
+(chicken.file.posix#perm/irwxg fixnum)
+(chicken.file.posix#perm/irwxo fixnum)
+(chicken.file.posix#perm/irwxu fixnum)
+(chicken.file.posix#perm/isgid fixnum)
+(chicken.file.posix#perm/isuid fixnum)
+(chicken.file.posix#perm/isvtx fixnum)
+(chicken.file.posix#perm/iwgrp fixnum)
+(chicken.file.posix#perm/iwoth fixnum)
+(chicken.file.posix#perm/iwusr fixnum)
+(chicken.file.posix#perm/ixgrp fixnum)
+(chicken.file.posix#perm/ixoth fixnum)
+(chicken.file.posix#perm/ixusr fixnum)
+
+(chicken.file.posix#port->fileno (#(procedure #:clean #:enforce) chicken.file.posix#port->fileno (port) fixnum))
+
+(chicken.file.posix#seek/cur fixnum)
+(chicken.file.posix#seek/end fixnum)
+(chicken.file.posix#seek/set fixnum)
+
+(chicken.file.posix#set-file-group! (#(procedure #:clean #:enforce) chicken.file.posix#set-file-group! ((or string fixnum port) fixnum) undefined))
+(chicken.file.posix#set-file-owner! (#(procedure #:clean #:enforce) chicken.file.posix#set-file-owner! ((or string fixnum port) fixnum) undefined))
+(chicken.file.posix#set-file-permissions! (#(procedure #:clean #:enforce) chicken.file.posix#set-file-permissions! ((or string fixnum port) fixnum) undefined))
+(chicken.file.posix#set-file-position! (#(procedure #:clean #:enforce) chicken.file.posix#set-file-position! ((or port fixnum) integer #!optional fixnum) undefined))
+(chicken.file.posix#set-file-times! (#(procedure #:clean #:enforce) chicken.file.posix#set-file-times! (string #!optional (or false integer) (or false integer)) undefined))
+
+
+
;; posix
(chicken.posix#call-with-input-pipe (#(procedure #:enforce) chicken.posix#call-with-input-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
@@ -1930,10 +2030,8 @@
(chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum))
(chicken.posix#close-input-pipe (#(procedure #:clean #:enforce) chicken.posix#close-input-pipe (input-port) fixnum))
(chicken.posix#close-output-pipe (#(procedure #:clean #:enforce) chicken.posix#close-output-pipe (output-port) fixnum))
-(chicken.posix#create-fifo (#(procedure #:clean #:enforce) chicken.posix#create-fifo (string #!optional fixnum) undefined))
(chicken.posix#create-pipe (procedure chicken.posix#create-pipe (#!optional fixnum) fixnum fixnum))
(chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum))
-(chicken.posix#create-symbolic-link (#(procedure #:clean #:enforce) chicken.posix#create-symbolic-link (string string) undefined))
(chicken.posix#current-effective-group-id (#(procedure #:clean) chicken.posix#current-effective-group-id () fixnum))
(chicken.posix#current-effective-user-id (#(procedure #:clean) chicken.posix#current-effective-user-id () fixnum))
@@ -1942,80 +2040,12 @@
(chicken.posix#current-process-id (#(procedure #:clean) chicken.posix#current-process-id () fixnum))
(chicken.posix#current-user-id (#(procedure #:clean) chicken.posix#current-user-id () fixnum))
(chicken.posix#current-user-name (#(procedure #:clean) chicken.posix#current-user-name () string))
-(chicken.posix#directory? (#(procedure #:clean #:enforce) chicken.posix#directory? ((or string fixnum)) boolean))
-(chicken.posix#duplicate-fileno (#(procedure #:clean #:enforce) chicken.posix#duplicate-fileno (fixnum #!optional fixnum) fixnum))
-(chicken.posix#fcntl/dupfd fixnum)
-(chicken.posix#fcntl/getfd fixnum)
-(chicken.posix#fcntl/getfl fixnum)
-(chicken.posix#fcntl/setfd fixnum)
-(chicken.posix#fcntl/setfl fixnum)
-(chicken.posix#file-access-time (#(procedure #:clean #:enforce) chicken.posix#file-access-time ((or string port fixnum)) integer))
-(chicken.posix#file-change-time (#(procedure #:clean #:enforce) chicken.posix#file-change-time ((or string port fixnum)) integer))
-(chicken.posix#file-close (#(procedure #:clean #:enforce) chicken.posix#file-close (fixnum) undefined))
-(chicken.posix#file-control (#(procedure #:clean #:enforce) chicken.posix#file-control (fixnum fixnum #!optional fixnum) fixnum))
-(chicken.posix#file-creation-mode (#(procedure #:clean #:enforce) chicken.posix#file-creation-mode (#!optional fixnum) fixnum))
-(chicken.posix#file-link (#(procedure #:clean #:enforce) chicken.posix#file-link (string string) undefined))
-(chicken.posix#file-lock (#(procedure #:clean #:enforce) chicken.posix#file-lock (port #!optional fixnum integer) (struct lock)))
-(chicken.posix#file-lock/blocking (#(procedure #:clean #:enforce) chicken.posix#file-lock/blocking (port #!optional fixnum integer) (struct lock)))
-(chicken.posix#file-mkstemp (#(procedure #:clean #:enforce) chicken.posix#file-mkstemp (string) fixnum string))
-(chicken.posix#file-modification-time (#(procedure #:clean #:enforce) chicken.posix#file-modification-time ((or string fixnum port)) integer))
-(chicken.posix#file-open (#(procedure #:clean #:enforce) chicken.posix#file-open (string fixnum #!optional fixnum) fixnum))
-(chicken.posix#file-group (#(procedure #:clean #:enforce) chicken.posix#file-owner ((or string fixnum)) fixnum))
-(chicken.posix#file-owner (#(procedure #:clean #:enforce) chicken.posix#file-owner ((or string fixnum)) fixnum))
-(chicken.posix#file-permissions (#(procedure #:clean #:enforce) chicken.posix#file-permissions ((or string fixnum)) fixnum))
-(chicken.posix#file-position (#(procedure #:clean #:enforce) chicken.posix#file-position ((or port fixnum)) integer))
-(chicken.posix#file-read (#(procedure #:clean #:enforce) chicken.posix#file-read (fixnum fixnum #!optional *) list))
-(chicken.posix#file-select (#(procedure #:clean #:enforce) chicken.posix#file-select ((or (list-of fixnum) fixnum false) (or (list-of fixnum) fixnum false) #!optional fixnum) * *))
-(chicken.posix#file-size (#(procedure #:clean #:enforce) chicken.posix#file-size ((or string fixnum)) integer))
-(chicken.posix#file-stat (#(procedure #:clean #:enforce) chicken.posix#file-stat ((or string fixnum) #!optional *) (vector-of integer)))
-(chicken.posix#file-test-lock (#(procedure #:clean #:enforce) chicken.posix#file-test-lock (port #!optional fixnum *) boolean))
-(chicken.posix#file-truncate (#(procedure #:clean #:enforce) chicken.posix#file-truncate ((or string fixnum) integer) undefined))
-(chicken.posix#file-type (#(procedure #:clean #:enforce) chicken.posix#file-type ((or string fixnum) #!optional * *) symbol))
-(chicken.posix#file-unlock (#(procedure #:clean #:enforce) chicken.posix#file-unlock ((struct lock)) undefined))
-(chicken.posix#file-write (#(procedure #:clean #:enforce) chicken.posix#file-write (fixnum * #!optional fixnum) fixnum))
-(chicken.posix#fileno/stderr fixnum)
-(chicken.posix#fileno/stdin fixnum)
-(chicken.posix#fileno/stdout fixnum)
(chicken.posix#local-time->seconds (#(procedure #:clean #:enforce) chicken.posix#local-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) integer))
(chicken.posix#local-timezone-abbreviation (#(procedure #:clean) chicken.posix#local-timezone-abbreviation () string))
-(chicken.posix#open-input-file* (#(procedure #:clean #:enforce) chicken.posix#open-input-file* (fixnum #!optional symbol) input-port))
(chicken.posix#open-input-pipe (#(procedure #:clean #:enforce) chicken.posix#open-input-pipe (string #!optional symbol) input-port))
-(chicken.posix#open-output-file* (#(procedure #:clean #:enforce) chicken.posix#open-output-file* (fixnum #!optional symbol) output-port))
(chicken.posix#open-output-pipe (#(procedure #:clean #:enforce) chicken.posix#open-output-pipe (string #!optional symbol) output-port))
-(chicken.posix#open/append fixnum)
-(chicken.posix#open/binary fixnum)
-(chicken.posix#open/creat fixnum)
-(chicken.posix#open/excl fixnum)
-(chicken.posix#open/fsync fixnum)
-(chicken.posix#open/noctty fixnum)
-(chicken.posix#open/noinherit fixnum)
-(chicken.posix#open/nonblock fixnum)
-(chicken.posix#open/rdonly fixnum)
-(chicken.posix#open/rdwr fixnum)
-(chicken.posix#open/read fixnum)
-(chicken.posix#open/sync fixnum)
-(chicken.posix#open/text fixnum)
-(chicken.posix#open/trunc fixnum)
-(chicken.posix#open/write fixnum)
-(chicken.posix#open/wronly fixnum)
(chicken.posix#parent-process-id (#(procedure #:clean) chicken.posix#parent-process-id () fixnum))
-(chicken.posix#perm/irgrp fixnum)
-(chicken.posix#perm/iroth fixnum)
-(chicken.posix#perm/irusr fixnum)
-(chicken.posix#perm/irwxg fixnum)
-(chicken.posix#perm/irwxo fixnum)
-(chicken.posix#perm/irwxu fixnum)
-(chicken.posix#perm/isgid fixnum)
-(chicken.posix#perm/isuid fixnum)
-(chicken.posix#perm/isvtx fixnum)
-(chicken.posix#perm/iwgrp fixnum)
-(chicken.posix#perm/iwoth fixnum)
-(chicken.posix#perm/iwusr fixnum)
-(chicken.posix#perm/ixgrp fixnum)
-(chicken.posix#perm/ixoth fixnum)
-(chicken.posix#perm/ixusr fixnum)
(chicken.posix#pipe/buf fixnum)
-(chicken.posix#port->fileno (#(procedure #:clean #:enforce) chicken.posix#port->fileno (port) fixnum))
(chicken.posix#process (#(procedure #:clean #:enforce) chicken.posix#process (string #!optional (list-of string) (list-of (pair string string)) boolean) input-port output-port fixnum))
(chicken.posix#process* (#(procedure #:clean #:enforce) chicken.posix#process* (string #!optional (list-of string) (list-of (pair string string)) boolean) input-port output-port fixnum *))
@@ -2030,20 +2060,10 @@
(chicken.posix#process-spawn
(#(procedure #:clean #:enforce) chicken.posix#process-spawn (fixnum string #!optional (list-of string) (list-of (pair string string)) boolean) fixnum))
(chicken.posix#process-wait (#(procedure #:clean #:enforce) chicken.posix#process-wait (#!optional fixnum *) fixnum fixnum fixnum))
-(chicken.posix#read-symbolic-link (#(procedure #:clean #:enforce) chicken.posix#read-symbolic-link (string #!optional boolean) string))
-(chicken.posix#regular-file? (#(procedure #:clean #:enforce) chicken.posix#regular-file? ((or string fixnum)) boolean))
(chicken.posix#seconds->local-time (#(procedure #:clean #:enforce) chicken.posix#seconds->local-time (#!optional integer) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
(chicken.posix#seconds->string (#(procedure #:clean #:enforce) chicken.posix#seconds->string (#!optional integer) string))
(chicken.posix#seconds->utc-time (#(procedure #:clean #:enforce) chicken.posix#seconds->utc-time (#!optional integer) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
-(chicken.posix#seek/cur fixnum)
-(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-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))
-(chicken.posix#set-file-position! (#(procedure #:clean #:enforce) chicken.posix#set-file-position! ((or port fixnum) integer #!optional fixnum) undefined))
-(chicken.posix#set-file-times! (#(procedure #:clean #:enforce) chicken.posix#set-file-times! (string #!optional (or false integer) (or false integer)) undefined))
(chicken.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined))
(chicken.posix#set-signal-handler! (#(procedure #:clean #:enforce) chicken.posix#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined))
(chicken.posix#set-signal-mask! (#(procedure #:clean #:enforce) chicken.posix#set-signal-mask! ((list-of fixnum)) undefined))
@@ -2085,12 +2105,7 @@
(chicken.posix#spawn/nowaito fixnum)
(chicken.posix#spawn/detach fixnum)
(chicken.posix#process-sleep (#(procedure #:clean #:enforce) chicken.posix#process-sleep (fixnum) fixnum))
-(chicken.posix#block-device? (#(procedure #:clean #:enforce) chicken.posix#block-device? ((or string fixnum)) boolean))
-(chicken.posix#character-device? (#(procedure #:clean #:enforce) chicken.posix#character-device? ((or string fixnum)) boolean))
-(chicken.posix#fifo? (#(procedure #:clean #:enforce) chicken.posix#fifo? ((or string fixnum)) boolean))
-(chicken.posix#socket? (#(procedure #:clean #:enforce) chicken.posix#socket? ((or string fixnum)) boolean))
(chicken.posix#string->time (#(procedure #:clean #:enforce) chicken.posix#string->time (string #!optional string) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
-(chicken.posix#symbolic-link? (#(procedure #:clean #:enforce) chicken.posix#symbolic-link? ((or string fixnum)) boolean))
(chicken.posix#time->string (#(procedure #:clean #:enforce) chicken.posix#time->string ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum) #!optional string) string))
(chicken.posix#user-information (#(procedure #:clean #:enforce) chicken.posix#user-information ((or string fixnum) #!optional *) *))
(chicken.posix#utc-time->seconds (#(procedure #:clean #:enforce) chicken.posix#utc-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) integer))
Trap