From 2b9ef4a4df8ac14d507bd9496f448ca4802c49b7 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 2 Jan 2026 20:13:05 +0200 Subject: [PATCH] Backup --- Dockerfile | 5 +++-- Makefile | 6 ++---- srfi/106.scm | 24 ++++++++++++------------ 3 files changed, 17 insertions(+), 18 deletions(-) diff --git a/Dockerfile b/Dockerfile index bbc32a6..f9bf119 100644 --- a/Dockerfile +++ b/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/ diff --git a/Makefile b/Makefile index 817d0b7..51435b7 100644 --- a/Makefile +++ b/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}/ - -clean: - git clean -X -f + cp -r foreign ${TMPDIR}/ diff --git a/srfi/106.scm b/srfi/106.scm index 20de4e4..3335eae 100644 --- a/srfi/106.scm +++ b/srfi/106.scm @@ -72,8 +72,8 @@ (define SO-REUSEPORT 15) (define AI-PASSIVE 1) -(define +sockaddr-size+ 16) -(define +ai-family-size+ 2) +(define *sockaddr-size* 16) +(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 ()