Backup

Dockerfile

@@ -22,7 +22,8 @@ RUN git clone https://codeberg.org/foreign-c/foreign-c.git --depth=2
 ARG SCHEME=chibi
 ARG IMAGE=${SCHEME}:head
 FROM schemers/${IMAGE}
-RUN apt-get update && apt-get install -y make gcc libffi-dev libcurl4 gauche
+RUN apt-get update && apt-get install -y make gcc libffi-dev libcurl4 gauche \
+    netcat-traditional ca-certificates curl
 RUN mkdir ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
 COPY --from=build /build /build
 ARG SCHEME=chibi
@@ -46,4 +47,4 @@ RUN cp -r /build/foreign-c-libraries/retropikzel retropikzel/
 RUN cp -r /build/foreign-c/foreign .
 COPY Makefile .
 COPY srfi srfi/
-
+COPY foreign foreign/

Makefile

@@ -45,7 +45,7 @@ test-r7rs-docker:
 test-r6rs: tmpdir
 	cd ${TMPDIR} && echo "(import (rnrs) (foreign c) (srfi :${SRFI}) (srfi :64))" > test-r6rs.sps
 	cd ${TMPDIR} && cat srfi/${SRFI}/test.scm >> test-r6rs.sps
-	cd ${TMPDIR} && akku install chez-srfi akku-r7rs "(foreign c)" #"(retropikzel shell)"
+	cd ${TMPDIR} && akku install chez-srfi akku-r7rs #"(foreign c)" "(retropikzel shell)"
 	cd ${TMPDIR} && COMPILE_R7RS=${SCHEME} compile-scheme -I .akku/lib -o test-r6rs test-r6rs.sps
 	cd ${TMPDIR} && ./test-r6rs
 
@@ -57,6 +57,4 @@ tmpdir:
 	rm -rf ${TMPDIR}
 	mkdir -p ${TMPDIR}
 	cp -r srfi ${TMPDIR}/
-
+	cp -r foreign ${TMPDIR}/
-clean:
-	git clean -X -f

srfi/106.scm

@@ -72,8 +72,8 @@
 (define SO-REUSEPORT 15)
 (define AI-PASSIVE 1)
 
-(define +sockaddr-size+ 16)
+(define *sockaddr-size* 16)
-(define +ai-family-size+ 2)
+(define *ai-family-size* 2)
 
 (define socket-merge-flags (lambda flags (apply + flags)))
 (define (socket-purge-flags base-flag . flags) (apply - (cons base-flag flags)))
@@ -134,11 +134,11 @@
            (let* ((pointer (make-c-bytevector 128 0))
                   (pointer-address (c-bytevector->address pointer))
                   (node-pointer (address->c-bytevector
-                                  (+ pointer-address +ai-family-size+))))
+                                  (+ pointer-address *ai-family-size*))))
              (c-bytevector-set! pointer 'u16 0 *af-unix*)
              (c-strcpy node-pointer (string->c-utf8 node))
              pointer))
-         (sockaddr-size (+ +ai-family-size+ (bytevector-length (string->utf8 node)))))
+         (sockaddr-size (+ *ai-family-size* (bytevector-length (string->utf8 node)))))
     (when (< socket-file-descriptor 0)
       (c-perror (string->c-utf8 "make-client-socket (socket) error"))
       (raise-continuable "make-client-socket (socket) error"))
@@ -214,7 +214,7 @@
            (let* ((pointer (make-c-bytevector 128 0))
                   (pointer-address (c-bytevector->address pointer))
                   (node-pointer (address->c-bytevector
-                                  (+ pointer-address +ai-family-size+))))
+                                  (+ pointer-address *ai-family-size*))))
              (c-bytevector-set! pointer 'u16 0 *af-inet*)
              (c-bytevector-set! pointer
                                 'u16
@@ -226,7 +226,7 @@
          (option (let ((pointer (make-c-bytevector (c-type-size 'int))))
                    (c-bytevector-set! pointer 'int 0 1)
                    pointer))
-         (sockaddr-size (+ +ai-family-size+ (bytevector-length (string->utf8 node)))))
+         (sockaddr-size (+ *ai-family-size* (bytevector-length (string->utf8 node)))))
     (when (< socket-file-descriptor 0)
       (c-perror (string->c-utf8 "make-server-socket (socket) error"))
       (raise-continuable "make-server-socket (socket) error"))
@@ -236,7 +236,7 @@
     (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEPORT option (c-type-size 'int)) 0)
       (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEPORT) error"))
       (raise-continuable "make-server-socket (setsockopt SO-REUSEPORT) error"))
-    (when (< (c-bind socket-file-descriptor sockaddr +sockaddr-size+) 0)
+    (when (< (c-bind socket-file-descriptor sockaddr *sockaddr-size*) 0)
       (c-perror (string->c-utf8 "socket-accept (bind) error"))
       (raise-continuable "socket-accept (bind) error"))
     (when (< (c-listen socket-file-descriptor 0) 0)
@@ -337,19 +337,19 @@
            ((symbol=? 'name 'inet6) *af-inet6*)
            ((symbol=? 'name 'unspec) *af-unspec*)
            ((symbol=? 'name 'unix) *af-unix*)
-           (else (error "address-family: Unrecognized name" name))))))
+           (else (error "address-family: Unrecognized name" 'name))))))
 
 (define-syntax address-info
   (syntax-rules ()
     ((_ names ...)
      (apply socket-merge-flags
             (map (lambda (name)
-                   (cond ((symbol=? name 'canoname) *ai-canoname*)
+                   (cond ((symbol=? name 'canonname) *ai-canonname*)
                          ((symbol=? name 'numerichost) *ai-numerichost*)
                          ((symbol=? name 'v4mapped) *ai-v4mapped*)
                          ((symbol=? name 'all) *ai-all*)
                          ((symbol=? name 'addrconfig) *ai-addrconfig*)
-                         (else (error "address-info: Unrecognized name" name))))
+                         (else (error "address-info: Unrecognized name" 'name))))
                  '(names ...))))))
 
 (define-syntax socket-domain
@@ -357,7 +357,7 @@
     ((_ name)
      (cond ((symbol=? 'name 'stream) *sock-stream*)
            ((symbol=? 'name 'datagram) *af-unix*)
-           (else (error "socket-domain: Unrecognized name" name))))))
+           (else (error "socket-domain: Unrecognized name" 'name))))))
 
 (define-syntax ip-protocol
   (syntax-rules ()
@@ -365,7 +365,7 @@
      (cond ((symbol=? 'name 'ip) *ipproto-ip*)
            ((symbol=? 'name 'tcp) *ipproto-tcp*)
            ((symbol=? 'name 'udp) *ipproto-udp*)
-           (else (error "ip-protocol: Unrecognized name" name))))))
+           (else (error "ip-protocol: Unrecognized name" 'name))))))
 
 (define-syntax shutdown-method
   (syntax-rules ()