Update named-pipes to new (foreign c)

This commit is contained in:
retropikzel 2026-02-27 09:14:46 +02:00
parent a8cb73d828
commit 57403bfecc
3 changed files with 17 additions and 20 deletions

View File

@ -40,11 +40,11 @@ init-venv: build
cat ${TESTFILE} >> venv/test.sps cat ${TESTFILE} >> venv/test.sps
if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi
if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel venv/lib/; fi if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel venv/lib/; fi
if [ "${SCHEME}" = "chezs" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi #if [ "${SCHEME}" = "chezscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
if [ "${SCHEME}" = "ikarus" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi #if [ "${SCHEME}" = "ikarus" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
if [ "${SCHEME}" = "ironscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi #if [ "${SCHEME}" = "ironscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
if [ "${SCHEME}" = "racket" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi #if [ "${SCHEME}" = "racket" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/akku install; fi if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
if [ "${SCHEME}" = "chicken" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi if [ "${SCHEME}" = "chicken" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi

View File

@ -1,10 +1,7 @@
;; TODO output-pipe and input-pipe types ;; TODO output-pipe and input-pipe types
;; TODO Check on writing that given pipe is output pipe ;; TODO Check on writing that given pipe is output pipe
;; TODO Check on reading that given pipe is input pipe ;; TODO Check on reading that given pipe is input pipe
(define-c-library libc-stdlib (define-c-library libc-stdlib '("stdlib.h" "errno.h" "fcntl.h") #f '())
'("stdlib.h" "errno.h" "fcntl.h")
libc-name
'((additional-versions ("0" "6"))))
;(define-c-procedure c-system libc-stdlib 'system 'int '(pointer)) ;(define-c-procedure c-system libc-stdlib 'system 'int '(pointer))
(define-c-procedure c-mkfifo libc-stdlib 'mkfifo 'int '(pointer int)) (define-c-procedure c-mkfifo libc-stdlib 'mkfifo 'int '(pointer int))
@ -42,13 +39,13 @@
(display "HERE: ") (display "HERE: ")
(write return-code) (write return-code)
(newline) (newline)
(c-perror (string->c-utf8 msg)) (c-perror (string->c-bytevector msg))
(error msg return-code)) (error msg return-code))
return-code)) return-code))
(define create-pipe (define create-pipe
(lambda (path mode) (lambda (path mode)
(let* ((path* (string->c-utf8 path)) (let* ((path* (string->c-bytevector path))
(octal-mode (string->number (string-append "#o" (octal-mode (string->number (string-append "#o"
(number->string mode))))) (number->string mode)))))
(handle-c-errors (string-append "open-output-pipe mkfifo: " (handle-c-errors (string-append "open-output-pipe mkfifo: "
@ -65,7 +62,7 @@
(make-input-pipe path (make-input-pipe path
(handle-c-errors (string-append "open-input-pipe open" (handle-c-errors (string-append "open-input-pipe open"
"(Note that: A process can open a FIFO in nonblocking mode. In this case, opening for read-only succeeds even if no one has opened on the write side yet and opening for write-only fails with ENXIO (no such device or address) unless the other end has already been opened.)") "(Note that: A process can open a FIFO in nonblocking mode. In this case, opening for read-only succeeds even if no one has opened on the write side yet and opening for write-only fails with ENXIO (no such device or address) unless the other end has already been opened.)")
(c-open (string->c-utf8 path) (c-open (string->c-bytevector path)
(if (null? block?) (if (null? block?)
O_RDONLY+O_NONBLOCK+O_CREAT O_RDONLY+O_NONBLOCK+O_CREAT
O_RDONLY+O_CREAT) O_RDONLY+O_CREAT)
@ -77,7 +74,7 @@
(handle-c-errors (string-append "open-output-pipe open" (handle-c-errors (string-append "open-output-pipe open"
" " " "
"(Note that: A process can open a FIFO in nonblocking mode. In this case, opening for read-only succeeds even if no one has opened on the write side yet and opening for write-only fails with ENXIO (no such device or address) unless the other end has already been opened.)") "(Note that: A process can open a FIFO in nonblocking mode. In this case, opening for read-only succeeds even if no one has opened on the write side yet and opening for write-only fails with ENXIO (no such device or address) unless the other end has already been opened.)")
(c-open (string->c-utf8 path) (c-open (string->c-bytevector path)
(if (null? block?) (if (null? block?)
O_WRONLY+O_NONBLOCK+O_CREAT O_WRONLY+O_NONBLOCK+O_CREAT
O_WRONLY+O_CREAT) O_WRONLY+O_CREAT)
@ -133,11 +130,11 @@
(error "Can only read from input-pipe" pipe)) (error "Can only read from input-pipe" pipe))
(let* ((buffer (make-c-bytevector (* (c-type-size 'char) count))) (let* ((buffer (make-c-bytevector (* (c-type-size 'char) count)))
(read-count (c-read (input-file-descriptor pipe) buffer count)) (read-count (c-read (input-file-descriptor pipe) buffer count))
(text (string-copy (c-utf8->string buffer)))) (text (string-copy (c-bytevector->string buffer))))
(display "text: ") (display "text: ")
(display text) (display text)
(newline) (newline)
(c-free buffer) (c-bytevector-free buffer)
(if (> read-count 0) text (eof-object))))) (if (> read-count 0) text (eof-object)))))
(define pipe-read-string (define pipe-read-string
@ -146,8 +143,8 @@
(error "Can only read from input-pipe" pipe)) (error "Can only read from input-pipe" pipe))
(let* ((buffer (make-c-bytevector (* (c-type-size 'char) count))) (let* ((buffer (make-c-bytevector (* (c-type-size 'char) count)))
(read-count (c-read (input-file-descriptor pipe) buffer count)) (read-count (c-read (input-file-descriptor pipe) buffer count))
(text (c-utf8->string buffer))) (text (c-bytevector->string buffer)))
(c-free buffer) (c-bytevector-free buffer)
(if (> read-count 0) text (eof-object))))) (if (> read-count 0) text (eof-object)))))
(define pipe-write-string (define pipe-write-string
@ -155,9 +152,9 @@
(when (not (output-pipe? pipe)) (when (not (output-pipe? pipe))
(error "Can only write to output-pipe" pipe)) (error "Can only write to output-pipe" pipe))
(let ((count (string-length text)) (let ((count (string-length text))
(text-pointer (string->c-utf8 text))) (text-pointer (string->c-bytevector text)))
(c-write (output-file-descriptor pipe) text-pointer count) (c-write (output-file-descriptor pipe) text-pointer count)
(c-free text-pointer)))) (c-bytevector-free text-pointer))))
(define pipe-read-line (define pipe-read-line
(lambda (pipe) (lambda (pipe)

View File

@ -1 +1 @@
1.0.1 1.0.2