From 1718b8c102409d5451f5aa26f81609281394e380 Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Wed, 24 Jun 2026 19:24:14 +0300
Subject: [PATCH] Add create-fifo into SRFI-170

---
 Makefile     |  3 ---
 srfi/170.scm | 31 +++++++++++++++++++++++++++----
 srfi/170.sld |  2 +-
 3 files changed, 28 insertions(+), 8 deletions(-)

diff --git a/Makefile b/Makefile
index 3bc8d07..e380a5b 100644
--- a/Makefile
+++ b/Makefile
@@ -36,9 +36,6 @@ package: srfi/${SRFI}/LICENSE srfi/${SRFI}/VERSION
 install:
 	snow-chibi install --impls=${SCHEME} ${PKG}
 
-uninstall:
-	-snow-chibi remove --impls=${SCHEME} ${PKG}
-
 testfiles:
 	rm -rf .tmp
 	mkdir -p .tmp
diff --git a/srfi/170.scm b/srfi/170.scm
index 0abd6f8..cb15210 100644
--- a/srfi/170.scm
+++ b/srfi/170.scm
@@ -14,6 +14,7 @@
 
 (define-c-procedure c-perror libc 'perror 'void '(pointer))
 (define-c-procedure c-mkdir libc 'mkdir 'int '(pointer int))
+(define-c-procedure c-mkfifo libc 'mkfifo 'int '(pointer int))
 (define-c-procedure c-rmdir libc 'rmdir 'int '(pointer))
 (define-c-procedure c-stat libc 'stat 'int '(pointer pointer))
 (define-c-procedure c-lstat libc 'stat 'int '(pointer pointer))
@@ -134,8 +135,10 @@
     (let* ((fname-pointer (string->c-bytevector fname))
            (mode (if (null? permission-bits)
                    #o775
-                   (string->number (string-append "#o"
-                                                  (number->string (car permission-bits))))))
+                   (string->number
+                     (string-append
+                       "#o"
+                       (number->string (car permission-bits))))))
            (result (c-mkdir fname-pointer mode))
            (error-message "create-directory error")
            (error-pointer (string->c-bytevector error-message)))
@@ -143,7 +146,26 @@
       (when (< result 0)
         (c-perror error-pointer)
         (c-bytevector-free error-pointer)
-        (error error-message)))))
+        (error error-message))
+      (c-bytevector-free error-pointer))))
+
+(define (create-fifo fname . permission-bits)
+  (let* ((fname-pointer (string->c-bytevector fname))
+         (mode (if (null? permission-bits)
+                 #o664
+                 (string->number
+                   (string-append
+                     "#o"
+                     (number->string (car permission-bits))))))
+         (result (c-mkfifo fname-pointer mode))
+         (error-message "create-fifo error")
+         (error-pointer (string->c-bytevector error-message)))
+    (c-bytevector-free fname-pointer)
+    (when (< result 0)
+      (c-perror error-pointer)
+      (c-bytevector-free error-pointer)
+      (error error-message))
+    (c-bytevector-free error-pointer)))
 
 (define (create-hard-link old-fname new-fname)
   (c-link (string->c-bytevector old-fname)
@@ -154,7 +176,8 @@
            (string->c-bytevector new-fname)))
 
 (define (rename-file old-fname new-fname)
-  (c-rename (string->c-bytevector old-fname) (string->c-bytevector new-fname)))
+  (c-rename (string->c-bytevector old-fname)
+            (string->c-bytevector new-fname)))
 
 (define (delete-directory fname)
   (let* ((fname-pointer (string->c-bytevector fname))
diff --git a/srfi/170.sld b/srfi/170.sld
index dd541a0..4f63443 100644
--- a/srfi/170.sld
+++ b/srfi/170.sld
@@ -12,7 +12,7 @@
           ;open-file
           ;fd->port
           create-directory
-          ;create-fifo
+          create-fifo
           create-hard-link
           create-symlink
           ;read-symlink