88 lines
2.2 KiB
Scheme
88 lines
2.2 KiB
Scheme
|
;;; Flags for open(2) and fcntl(2).
|
||
|
;;; Copyright (c) 1993 by Olin Shivers.
|
||
|
;;; Copyright (c) 1994 by Brian D. Carlstrom
|
||
|
|
||
|
(define-syntax define-open-flags
|
||
|
(syntax-rules ()
|
||
|
((define-opens form ...)
|
||
|
(begin (define-enum-constant "open" . form) ...))))
|
||
|
|
||
|
(define-open-flags
|
||
|
;; POSIX
|
||
|
(read #x0000)
|
||
|
(write #x0001)
|
||
|
(read+write #x0002)
|
||
|
(nonblocking #x0800) ; no delay
|
||
|
(append #x0400) ; set append mode
|
||
|
|
||
|
;; Linux
|
||
|
(shlock #x0004) ; open with shared file lock
|
||
|
(exlock #x0008) ; open with exclusive file lock
|
||
|
(async #x2000) ; signal pgrep when data ready
|
||
|
(fsync #x1000) ; synchronus writes
|
||
|
|
||
|
;; POSIX
|
||
|
(create #x0040) ; create if nonexistant
|
||
|
(truncate #x0200) ; truncate to zero length
|
||
|
(exclusive #x0080) ; error if already exists
|
||
|
(no-control-tty #x0100)) ; don't assign controlling terminal
|
||
|
|
||
|
|
||
|
|
||
|
(define open/access-mask
|
||
|
(bitwise-ior open/read
|
||
|
(bitwise-ior open/write open/read+write)))
|
||
|
|
||
|
;;;; fcntl
|
||
|
;;;; Rough sketch only. Will define a separate proc for each fcntl command.
|
||
|
;
|
||
|
;;;; fcntl commands
|
||
|
;dup
|
||
|
;
|
||
|
;get-flags ; Only gives close-on-exec bit.
|
||
|
;set-flags
|
||
|
;
|
||
|
;get-status ; Returns open flags + get-status flags (below)
|
||
|
;set-status ; Can set: append, sync, async, nbio, nonblocking, no-delay
|
||
|
;
|
||
|
;get-lock
|
||
|
;set-lock
|
||
|
;nonblocking-set-lock
|
||
|
;
|
||
|
;get-record-lock
|
||
|
;set-record-lock
|
||
|
;set-record-lock-noblock
|
||
|
;
|
||
|
;get-owner ; Not POSIX
|
||
|
;set-owner ; Not POSIX
|
||
|
;remote-set-lock ; Not POSIX
|
||
|
;nonblocking-remote-set-lock ; Not POSIX
|
||
|
;remote-get-lock ; Not POSIX
|
||
|
;
|
||
|
;;;; Flags
|
||
|
;
|
||
|
;close-on-exec ; get-flags
|
||
|
;
|
||
|
;async ; get-status
|
||
|
;no-delay ; get-status
|
||
|
;nbio ; get-status
|
||
|
;
|
||
|
;;; These are internal; they are not part of the supported scsh interface.
|
||
|
|
||
|
(define fcntl/close-on-exec 1)
|
||
|
|
||
|
(define fcntl/dupfd 0)
|
||
|
(define fcntl/get-fd-flags 1)
|
||
|
(define fcntl/set-fd-flags 2)
|
||
|
(define fcntl/get-file-flags 3)
|
||
|
(define fcntl/set-file-flags 4)
|
||
|
(define fcntl/get-owner 9) ; Not POSIX
|
||
|
(define fcntl/set-owner 8) ; Not POSIX
|
||
|
(define fcntl/get-record-lock 5) ; F_GETLK
|
||
|
(define fcntl/set-record-lock-noblock 6) ; F_SETLK
|
||
|
(define fcntl/set-record-lock 7) ; F_SETLKW
|
||
|
|
||
|
(define lock/read 0) ; F_RDLCK
|
||
|
(define lock/release 2) ; F_UNLCK
|
||
|
(define lock/write 1) ; F_WRLCK
|