From 484955fedbf85a500509b5fbe8f5ed2102814de9 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 30 Apr 2018 14:38:14 +0200 Subject: [PATCH 1/5] 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. --- posix-common.scm | 301 +++++++++++++++++++++++++++----------------- posix.scm | 285 ++++++++++++++++++++---------------------- posixunix.scm | 370 ++++++++++++++++++++++--------------------------------- posixwin.scm | 176 +++++++------------------- types.db | 185 +++++++++++++++------------- 5 files changed, 615 insertions(+), 702 deletions(-) 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)) -- 2.11.0